home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / ALLERLEI / GOBJ_112 / UNITS / OWINDOWS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-14  |  283.2 KB  |  11,781 lines
  1. {**************************************
  2.  *  O b j e c t G E M   Version 1.12  *
  3.  *  Copyright 1992-94 by Thomas Much  *
  4.  **************************************
  5.  *       Unit  O W I N D O W S        *
  6.  **************************************
  7.  *    Softdesign Computer Software    *
  8.  *    Thomas Much, Gerwigstraße 46,   *
  9.  *  76131 Karlsruhe, (0721) 62 28 41  *
  10.  *         Thomas Much @ KA2          *
  11.  *  UK48@ibm3090.rz.uni-karlsruhe.de  *
  12.  **************************************
  13.  *    erstellt am:        13.07.1992  *
  14.  *    letztes Update am:  14.04.1994  *
  15.  **************************************}
  16.  
  17. {
  18.   WICHTIGE ANMERKUNGEN ZUM QUELLTEXT:
  19.  
  20.   ObjectGEM wird ab sofort mit dem _vollständigen_ Quelltext ausgeliefert,
  21.   d.h. jeder kann sich die Unit selbst compilieren, womit die extrem
  22.   lästigen Kompatibilitätsprobleme mit den PP-Releases beseitigt sind.
  23.   ObjectGEM ist und bleibt aber trotzdem SHAREWARE, d.h. wer die Biblio-
  24.   thek regelmäßig benutzt, muß sich REGISTRIEREN lassen (so wie bisher).
  25.   Im Moment gibt es dafür dann "nur" die neueste Version; eine geTEXte
  26.   Doku ist aber in Arbeit, so daß auch ein gedrucktes Handbuch immer
  27.   wahrscheinlicher wird.
  28.  
  29.   Der Quelltext enthält z.Z. noch _keine_ Kommentare; wer sich dennoch die
  30.   Mühe macht, ihn zu lesen, wird feststellen, daß er außerdem noch recht
  31.   "wirr" und teilweise umständlich geschrieben ist, oder daß er evtl. auch
  32.   unnötige Teile enthält. Das liegt daran, daß dieser Quelltext eigentlich
  33.   gar nicht für eine Veröffentlichung gedacht war, aber immer häufiger auf-
  34.   tretende PP-Updates haben mich schier zur Verzweiflung getrieben...
  35.   Das alles sollte aber kein Grund sein, ObjectGEM nicht einzusetzen, denn
  36.   sobald nach "außen" die von mir gewünschte Funktionalität erreicht ist
  37.   (d.h. wenn alle wichtigen Objekte vorhanden sind, z.B. TEditWindow etc.),
  38.   werde ich mich um die "innere" Optimierung kümmern (dazu gehören dann
  39.   auch die Kommentare). Die bisher geschriebenen ObjectGEM-Anwendungen
  40.   können dann natürlich weiterverwendet werden.
  41.  
  42.   Wer beim Durchstöbern des Textes auf vermeintliche Fehler oder verbesse-
  43.   rungswürdige Stellen trifft (von letzterem gibt es sicherlich noch viele),
  44.   kann mir dies gerne mitteilen - ich habe auch ich nichts gegen kostenlos
  45.   zur Verfügung gestellte optimierte Routinen (sofern sich jemand die Mühe
  46.   macht). Wer in anderen Projekten, die nicht in direkter Konkurrenz zu
  47.   ObjectGEM stehen, einzelne Routinen verwenden möchte, wendet sich bitte
  48.   an mich (ein solcher Austausch sollte kein Problem sein).
  49.  
  50.   Wer sich auf nicht dokumentierte "implementation"- oder "private"-Eigen-
  51.   schaften verläßt, darf sich nicht über Inkompatibilitäten zu späteren
  52.   Versionen wundern; wer meint, eine Dokumentationslücke entdeckt zu haben
  53.   (außer dem "Abgrund" des noch fehlenden Handbuchs...), kann mir dies
  54.   gerne mitteilen.
  55.  
  56.   WICHTIG: Wer den Quelltext verändert und dann Probleme beim Compilieren,
  57.   Ausführen o.ä. hat, kann nicht damit rechnen, daß ich den Fehler suche;
  58.   tritt der Fehler allerdings auch mit dem Original-Quelltext auf, würde
  59.   ich mich über eine genaue Fehlerbeschreibung freuen. Veränderte Quell-
  60.   texte dürfen _nicht_ weitergegeben werden, dies wäre ein Verstoß gegen
  61.   das Copyright!
  62.  
  63.   Kleine Info zum Schluß: Als "default tabsize" verwende ich 2. Wer drei
  64.   Punkte ("...") im Quelltext entdeckt, hat eine Stelle gefunden, an der
  65.   ich z.Z. arbeite ;-)
  66.  
  67.   "Möge die OOP mit Euch sein!"
  68. }
  69.  
  70.  
  71. {$IFDEF DEBUG}
  72.     {$B+,D+,G-,I-,L+,N-,P-,Q+,R+,S+,T-,V-,X+,Z+}
  73. {$ELSE}
  74.     {$B+,D-,G-,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X+,Z+}
  75. {$ENDIF}
  76.  
  77. unit OWindows;
  78.  
  79. interface
  80.  
  81. uses
  82.  
  83.     Tos,Gem,Objects,OTypes,OProcs;
  84.  
  85. const
  86.  
  87.     S_Esc        = gem.Esc;
  88.     S_Undo       = gem.Undo;
  89.     S_Help       = gem.Help;
  90.  
  91. type
  92.  
  93.     PEvent       = ^TEvent;
  94.     PWindow      = ^TWindow;
  95.     PDialog      = ^TDialog;
  96.     PKeyMenu     = ^TKeyMenu;
  97.  
  98.     PEventObject = ^TEventObject;
  99.     TEventObject = object(TObject)
  100.         public
  101.         EventList: PEvent;
  102.         constructor Init;
  103.         destructor Done; virtual;
  104.     end;
  105.  
  106.     TEvent       = object(TObject)
  107.         public
  108.         Parent: PEventObject;
  109.         constructor Init(AParent: PEventObject);
  110.         destructor Done; virtual;
  111.         function TestKey(Stat,Key: integer): boolean; virtual;
  112.         function TestButton(mX,mY,BStat,KStat,Clicks: integer): boolean; virtual;
  113.         function TestMouse(M,mX,mY,BStat,KStat: integer): boolean; virtual;
  114.         function TestMessage(Pipe: Pipearray): boolean; virtual;
  115.         function TestMenu(mNum: integer): boolean; virtual;
  116.         procedure Work; virtual;
  117.         function Previous: PEvent; virtual;
  118.         function Next: PEvent; virtual;
  119.         private
  120.         Prev,
  121.         Nxt : PEvent
  122.     end;
  123.  
  124.     PValidator   = ^TValidator;
  125.     TValidator   = object(TObject)
  126.         public
  127.         Status,
  128.         Options: Word;
  129.         Window : PDialog;
  130.         constructor Init;
  131.         procedure Error; virtual;
  132.         function IsValid(s: string): boolean; virtual;
  133.         function IsValidInput(var s: string; SuppressFill: boolean): boolean; virtual;
  134.         function Valid(s: string): boolean; virtual;
  135.     end;
  136.  
  137.     PControl     = ^TControl;
  138.     TControl     = object(TObject)
  139.         public
  140.         Parent : PDialog;
  141.         Style  : word;
  142.         Flags  : byte;
  143.         ObjIndx,
  144.         ID     : integer;
  145.         ObjAddr: PObj;
  146.         constructor Init(AParent: PDialog; AnIndx: integer; Hlp: string);
  147.         destructor Done; virtual;
  148.         function TestIndex(AnIndx: integer): boolean; virtual;
  149.         function TestID(AnID: integer): boolean; virtual;
  150.         function TestShortCut(Key: integer): boolean; virtual;
  151.         procedure SetFlags(Mask: byte; OnOff: boolean); virtual;
  152.         function IsFlagSet(Mask: byte): boolean; virtual;
  153.         procedure SetState(StateFlag: integer); virtual;
  154.         function GetState: integer; virtual;
  155.         procedure Disable; virtual;
  156.         procedure Enable; virtual;
  157.         procedure SetColor(Color: integer); virtual;
  158.         function GetColor: integer; virtual;
  159.         procedure Hide(Draw: boolean); virtual;
  160.         procedure Unhide; virtual;
  161.         function IsHidden: boolean; virtual;
  162.         procedure DisableTransfer; virtual;
  163.         procedure EnableTransfer; virtual;
  164.         function Transfer(DataPtr: pointer; TransferFlag: word): word; virtual;
  165.         procedure Changed(AnIndx: integer; DblClick: boolean); virtual;
  166.         procedure Paint; virtual;
  167.         function IsHelpAvailable: boolean; virtual;
  168.         function GetHelp: string; virtual;
  169.         procedure SetHelp(Hlp: string); virtual;
  170.         function Previous: PControl; virtual;
  171.         function Next: PControl; virtual;
  172.         private
  173.         Prev,
  174.         Nxt     : PControl;
  175.         BHelp   : PString;
  176.         shortcut: integer
  177.     end;
  178.  
  179.     PButton      = ^TButton;
  180.     TButton      = object(TControl)
  181.         public
  182.         UsrDef: boolean;
  183.         UsrBlk: USERBLK; { Achtung: dieses Feld ist eigentlich _nicht_ öffentlich... }
  184.         constructor Init(AParent: PDialog; AnIndx,AnID: integer; UserDef: boolean; Hlp: string);
  185.         destructor Done; virtual;
  186.         function Install: boolean; virtual;
  187.         procedure SetText(ATextString: string); virtual;
  188.         function GetText: string; virtual;
  189.         private
  190.         oldflags,
  191.         oldstate: word;
  192.         function GetRawText: string;
  193.     end;
  194.  
  195.     PStatic      = ^TStatic;
  196.     TStatic      = object(TControl)
  197.         public
  198.         UsrDef : boolean;
  199.         TextLen: integer;
  200.         constructor Init(AParent: PDialog; AnIndx,ATextLen: integer; UserDef: boolean; Hlp: string);
  201.         destructor Done; virtual;
  202.         function Transfer(DataPtr: pointer; TransferFlag: word): word; virtual;
  203.         procedure SetText(ATextString: string); virtual;
  204.         function GetText: string; virtual;
  205.         function GetTextLen: integer; virtual;
  206.         procedure Clear; virtual;
  207.         private
  208.         UsrBlk  : USERBLK;
  209.         oldflags,
  210.         oldtype : word;
  211.         usrused : boolean
  212.     end;
  213.  
  214.     PEdit        = ^TEdit;
  215.     TEdit        = object(TStatic)
  216.         public
  217.         Validator: PValidator;
  218.         constructor Init(AParent: PDialog; AnIndx,ATextLen: integer; Hlp: string);
  219.         destructor Done; virtual;
  220.         procedure SetText(ATextString: string); virtual;
  221.         procedure SetColor(Color: integer); virtual;
  222.         procedure Edit; virtual;
  223.         function IsValid(ReportError: boolean): boolean; virtual;
  224.         function CanClose: boolean; virtual;
  225.         function CanUndo: boolean; virtual;
  226.         procedure Undo; virtual;
  227.         procedure Paste; virtual;
  228.         procedure Copy; virtual;
  229.         procedure Cut; virtual;
  230.         procedure Focus; virtual;
  231.         function IsModified: boolean; virtual;
  232.         procedure ClearModify; virtual;
  233.         procedure SetValidator(AValid: PValidator); virtual;
  234.         procedure SetCursor(CPos: integer); virtual;
  235.         function GetCursor: integer; virtual;
  236.         private
  237.         Uptr,
  238.         TPtr     : PChar;
  239.         modified : boolean;
  240.         EdIdx    : integer
  241.     end;
  242.  
  243.     PPopup       = ^TPopup;
  244.     TPopup       = object(TEvent)
  245.         public
  246.         PopTree: PTree;
  247.         pX,
  248.         pY,
  249.         pIndex,
  250.         pRows,
  251.         pMax,
  252.         pFlag  : integer;
  253.         constructor Init(AParent: PEventObject; tIndx,oIndx: integer);
  254.         function Execute: integer; virtual;
  255.         procedure SetText(nr: integer; ATextString: string); virtual;
  256.         function GetText(nr: integer): string; virtual;
  257.         procedure SetState(nr,StateFlag: integer); virtual;
  258.         function GetState(nr: integer): integer; virtual;
  259.         procedure Disable(nr: integer); virtual;
  260.         procedure Enable(nr: integer); virtual;
  261.         procedure SetCheck(nr,CheckFlag: integer); virtual;
  262.         function GetCheck(nr: integer): integer; virtual;
  263.         procedure Check(nr: integer); virtual;
  264.         procedure Uncheck(nr: integer); virtual;
  265.         procedure Toggle(nr: integer); virtual;
  266.         private
  267.         mnusr: USERBLK
  268.     end;
  269.  
  270.     PScroller    = ^TScroller;
  271.     TScroller    = object(TObject)
  272.         public
  273.         Window       : PWindow;
  274.         XUnit,
  275.         YUnit        : integer;
  276.         XPos,
  277.         Ypos,
  278.         XRange,
  279.         YRange,
  280.         XLine,
  281.         YLine,
  282.         XPage,
  283.         YPage        : longint;
  284.         TrackMode,
  285.         HasHScrollBar,
  286.         HasVScrollBar: boolean;
  287.         constructor Init(TheWindow: PWindow; TheXUnit,TheYUnit: integer; TheXRange,TheYRange: longint);
  288.         destructor Done; virtual;
  289.         procedure HScroll; virtual;
  290.         procedure VScroll; virtual;
  291.         function IsVisibleRect(X,Y,XExt,YExt: longint): boolean; virtual;
  292.         procedure ScrollBy(dX,dY: longint); virtual;
  293.         procedure ScrollTo(X,Y: longint); virtual;
  294.         procedure SetPageSize; virtual;
  295.         procedure SetSBarRange; virtual;
  296.         procedure SetRange(TheXRange,TheYRange: longint); virtual;
  297.         procedure SetUnits(TheXUnit,TheYUnit: integer); virtual;
  298.         function GetXOrg: longint; virtual;
  299.         function GetYOrg: longint; virtual;
  300.     end;
  301.  
  302.     TWindow      = object(TEventObject)
  303.         public
  304.         Attr     : TWindowAttr;
  305.         Class    : TWndClass;
  306.         Parent,
  307.         ChildList: PWindow;
  308.         Scroller : PScroller;
  309.         DlgTree  : PTree;
  310.         Full,
  311.         Curr,
  312.         Work     : GRECT;
  313.         vdiHandle: integer;
  314.         constructor Init(AParent: PWindow; ATitle: string);
  315.         destructor Done; virtual;
  316.         function GetStyle: integer; virtual;
  317.         function GetScroller: PScroller; virtual;
  318.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  319.         function GetClassName: string; virtual;
  320.         function GetIconTitle: string; virtual;
  321.         function CanClose: boolean; virtual;
  322.         function IsIconified: boolean; virtual;
  323.         function IsModeless: boolean; virtual;
  324.         function IsDialog: boolean; virtual;
  325.         function IsTop: boolean; virtual;
  326.         procedure EnableAutoCreate; virtual;
  327.         procedure DisableAutoCreate; virtual;
  328.         procedure GetFull; virtual;
  329.         procedure GetCurr; virtual;
  330.         procedure GetWork; virtual;
  331.         procedure SetCurr(r: GRECT); virtual;
  332.         procedure SetWork(r: GRECT); virtual;
  333.         procedure LoadToolbar(Indx: integer; Opposite: boolean); virtual;
  334.         procedure FreeToolbar; virtual;
  335.         procedure LoadDialog(Indx: integer); virtual;
  336.         procedure FreeDialog; virtual;
  337.         procedure SetDlgTree(tree: PTree); virtual;
  338.         procedure UpdateDialog; virtual;
  339.         procedure SetupSize; virtual;
  340.         procedure SetupWindow; virtual;
  341.         procedure ShutdownWindow; virtual;
  342.         procedure MakeWindow; virtual;
  343.         procedure Create; virtual;
  344.         procedure CreateChildren; virtual;
  345.         procedure OpenWindow; virtual;
  346.         procedure CloseWindow; virtual;
  347.         procedure Destroy; virtual;
  348.         procedure RawDestroy; virtual;
  349.         procedure Top; virtual;
  350.         procedure FullSize; virtual;
  351.         procedure Size(r: GRECT); virtual;
  352.         procedure Move(r: GRECT); virtual;
  353.         procedure InitPaint; virtual;
  354.         procedure Paint(var PaintInfo: TPaintStruct); virtual;
  355.         procedure IconPaint(var PaintInfo: TPaintStruct); virtual;
  356.         procedure ExitPaint; virtual;
  357.         procedure ForceRedraw; virtual;
  358.         procedure SetTitle(ATitle: string); virtual;
  359.         procedure SetSubTitle(AnInfo: string); virtual;
  360.         procedure SetGadgets(Style: integer); virtual;
  361.         procedure SetCursor(Crs: HCursor); virtual;
  362.         procedure Calc(ctype: integer; ri: GRECT; var ro: GRECT); virtual;
  363.         procedure ChkAlign(var r: GRECT); virtual;
  364.         procedure ChkMin(var r: GRECT); virtual;
  365.         procedure ChkMax(var r: GRECT); virtual;
  366.         procedure GetWorkMin(var minX,minY: integer); virtual;
  367.         procedure GetWorkMax(var maxX,maxY: integer); virtual;
  368.         function GetDC: integer; virtual;
  369.         procedure ReleaseDC; virtual;
  370.         procedure WMRedraw(X,Y,W,H: integer); virtual;
  371.         procedure WMTopped; virtual;
  372.         procedure WMClosed; virtual;
  373.         procedure WMFulled; virtual;
  374.         procedure WMArrowed(wA: integer); virtual;
  375.         procedure WMHSlid(Value: integer); virtual;
  376.         procedure WMVSlid(Value: integer); virtual;
  377.         procedure WMSized(X,Y,W,H: integer); virtual;
  378.         procedure WMMoved(X,Y,W,H: integer); virtual;
  379.         procedure WMButton(mX,mY,BStat,KStat,Clicks: integer); virtual;
  380.         procedure WMClick(mX,mY,KStat: integer); virtual;
  381.         procedure WMDblClick(mX,mY,KStat: integer); virtual;
  382.         procedure WMRButton(mX,mY,KStat,Clicks: integer); virtual;
  383.         procedure WMRubbox(r: GRECT); virtual;
  384.         procedure WMRBoxChanged(r: GRECT); virtual;
  385.         procedure WMRBoxCheck(x,y,xmin,ymin,xmax,ymax: integer; var mx,my: integer); virtual;
  386.         procedure WMNewTop; virtual;
  387.         procedure WMUntopped; virtual;
  388.         procedure WMOnTop; virtual;
  389.         procedure WMBottomed; virtual;
  390.         procedure WMToolbar(Indx,BStat,KStat,Clicks: integer); virtual;
  391.         function WMKeyDown(Stat,Key: integer): boolean; virtual;
  392.         procedure WMDragDrop(PipeHnd,OrgID,mX,mY,KStat: integer); virtual;
  393.         procedure WMIconify(iX,iY,iW,iH: integer); virtual;
  394.         procedure WMUniconify(oX,oY,oW,oH: integer); virtual;
  395.         procedure WAUpPage; virtual;
  396.         procedure WADnPage; virtual;
  397.         procedure WAUpLine; virtual;
  398.         procedure WADnLine; virtual;
  399.         procedure WALfPage; virtual;
  400.         procedure WARtPage; virtual;
  401.         procedure WALfLine; virtual;
  402.         procedure WARtLine; virtual;
  403.         function DDGetPreferredTypes: string; virtual;
  404.         function DDGetPath: string; virtual;
  405.         function DDHeaderReply(dType,dName,fName: string; dSize: longint; OrgID,mX,mY,KStat: integer): byte; virtual;
  406.         function DDReadData(dType,dName,fName: string; dSize: longint; PipeHnd,OrgID,mX,mY,KStat: integer): boolean; virtual;
  407.         function DDReadArgs(dSize: longint; PipeHnd,OrgID,mX,mY,KStat: integer): boolean; virtual;
  408.         procedure DDFinished(OrgID,mX,mY,KStat: integer); virtual;
  409.         function Previous: PWindow; virtual;
  410.         function Next: PWindow; virtual;
  411.         function At(Index: integer): PWindow; virtual;
  412.         function IndexOf(Item: PWindow): integer; virtual;
  413.         function FirstWndThat(Test: PIterationFunc): PWindow; virtual;
  414.         procedure ForEachWnd(Action: PIterationProc); virtual;
  415.         function FirstWorkRect(var Rect: GRECT): boolean; virtual;
  416.         function NextWorkRect(var Rect: GRECT): boolean; virtual;
  417.         private
  418.         Prev,
  419.         Nxt     : PWindow;
  420.         icntitl : PString;
  421.         icnx,
  422.         tbsize,
  423.         tbtree,
  424.         icfpos,
  425.         icfstyle: integer;
  426.         icfcurr : GRECT;
  427.         procedure EnableCrsWatch;
  428.         procedure DisableCrsWatch;
  429.         procedure Iconify(fade: boolean);
  430.     end;
  431.  
  432.     PApplication = ^TApplication;
  433.     TApplication = object(TEventObject)
  434.         public
  435.         Name,
  436.         apName,
  437.         apPath       : PString;
  438.         ID           : TCookieID;
  439.         Status,
  440.         vdiHandle,
  441.         aesHandle,
  442.         apID,
  443.         menuID       : integer;
  444.         workIn       : workin_ARRAY;
  445.         workOut      : workout_ARRAY;
  446.         Attr         : TGEMAttr;
  447.         XAcc         : TXAccAttr;
  448.         XAccList     : PCollection;
  449.         MetaDOS      : PMetaInfo;
  450.         MainWindow   : PWindow;
  451.         RscPtr       : PRsFile;
  452.         MenuTree     : PTree;
  453.         MessageBuffer: pointer;
  454.         MessageBLen,
  455.         AVServer     : integer;
  456.         apDTA        : DTA;
  457.         FirstInstance,
  458.         SpeedoActive,
  459.         GDOSActive,
  460.         MultiTOS,
  461.         MiNTActive,
  462.         IsQSBUsed,
  463.         FPUAvailable,
  464.         OSBAvailable : boolean;
  465.         constructor Init(AnID: TCookieID; AName: string);
  466.         destructor Done; virtual;
  467.         function CanClose: boolean; virtual;
  468.         function IsIconified: boolean; virtual;
  469.         procedure LoadResource(FileHiRes,FileLoRes: string); virtual;
  470.         procedure InitResource(AddrHiRes,AddrLoRes: pointer); virtual;
  471.         function GetAddr(Indx: integer): PTree; virtual;
  472.         function GetFImagePtr(Indx: integer): pointer; virtual;
  473.         function GetFStringPtr(Indx: integer): PChar; virtual;
  474.         function GetFString(Indx: integer): string; virtual;
  475.         function GetIconTitle: string; virtual;
  476.         procedure GetXAccAttr(var XAccAttr: TXAccAttr); virtual;
  477.         procedure Broadcast(Msg: pointer; sID: boolean); virtual;
  478.         function FindApplication(AName: string; AnID: integer; var XAccAttr: TXAccAttr): boolean; virtual;
  479.         procedure FreeResource; virtual;
  480.         procedure InstallDesktop(tIndx,oIndx: integer); virtual;
  481.         procedure RemoveDesktop; virtual;
  482.         procedure LoadMenu(Indx: integer); virtual;
  483.         procedure DrawMenu; virtual;
  484.         procedure FreeMenu; virtual;
  485.         function AutoFolder: boolean; virtual;
  486.         procedure InitGEM; virtual;
  487.         procedure ExitGEM; virtual;
  488.         procedure SetupVDI; virtual;
  489.         procedure InitApplication; virtual;
  490.         procedure InitInstance; virtual;
  491.         procedure InitMainWindow; virtual;
  492.         function GetCurrInstance: integer; virtual;
  493.         function GetGPWindow(gHnd: integer): PWindow; virtual;
  494.         function GetPWindow(Hnd: HWnd): PWindow; virtual;
  495.         function GetPTopWindow: PWindow; virtual;
  496.         function GetMsTimer: longint; virtual;
  497.         procedure GetCrsRect(var crect: GRECT); virtual;
  498.         function GetEvent(var data: TEventData): integer; virtual;
  499.         procedure MessageLoop; virtual;
  500.         procedure MUKeybd(data: TEventData); virtual;
  501.         procedure MUButton(data: TEventData); virtual;
  502.         procedure MURubbox(r: GRECT); virtual;
  503.         procedure MURBoxChanged(r: GRECT); virtual;
  504.         procedure MUM1(data: TEventData); virtual;
  505.         procedure MUM2(data: TEventData); virtual;
  506.         procedure MUMesag(data: TEventData); virtual;
  507.         procedure MUTimer(data: TEventData); virtual;
  508.         procedure MNSelected(meNum,mtNum: integer; Tree: PTree; PrIndx: integer); virtual;
  509.         procedure ACOpen(mID: integer); virtual;
  510.         function ACClose(mID,Why: integer): integer; virtual;
  511.         function APTerm(Why: integer): integer; virtual;
  512.         procedure APDragDrop(PipeID,OrgID,WindID,mX,mY,KStat: integer); virtual;
  513.         procedure ShutCompleted(Stat,ErrID,ErrCode: integer); virtual;
  514.         procedure ResChCompleted(Stat: integer); virtual;
  515.         procedure CHExit(ChID,ChRet: integer); virtual;
  516.         procedure SHWDraw(Drive: integer); virtual;
  517.         procedure CBUpdate(OrgID: integer; Bits: word; Ext: string); virtual;
  518.         procedure XAccID(OrgID,mID: integer; Msg,Ver: byte; pName: PChar); virtual;
  519.         procedure XAccAcc(accID,mID: integer; Msg,Ver: byte; pName: PChar); virtual;
  520.         function XAccInsert(accID,mID: integer; Msg,Ver: byte; pName: PChar): boolean; virtual;
  521.         procedure XAccExit(OrgID: integer); virtual;
  522.         function XAccText(OrgID: integer; pText: pointer): boolean; virtual;
  523.         function XAccKey(OrgID,Stat,Key: integer): boolean; virtual;
  524.         function XAccMeta(OrgID: integer; pData: pointer; lData: longint; Final: boolean): boolean; virtual;
  525.         function XAccIMG(OrgID: integer; pData: pointer; lData: longint; Final: boolean): boolean; virtual;
  526.         procedure AVProtokoll(OrgID: integer; Msg: word; AName: string); virtual;
  527.         procedure VAProtoStatus(OrgID: integer; Msg: word; AName: string); virtual;
  528.         function AVInsert(accID: integer; SrvMsg,AccMsg: word; AName: string): boolean; virtual;
  529.         procedure AVExit(OrgID: integer); virtual;
  530.         function DDGetPreferredTypes(WindID: integer): string; virtual;
  531.         function DDGetPath(WindID: integer): string; virtual;
  532.         function DDHeaderReply(dType,dName,fName: string; dSize: longint; WindID,OrgID,mX,mY,KStat: integer): byte; virtual;
  533.         function DDReadData(dType,dName,fName: string; dSize: longint; PipeHnd,WindID,OrgID,mX,mY,KStat: integer): boolean; virtual;
  534.         function DDReadArgs(dSize: longint; PipeHnd,WindID,OrgID,mX,mY,KStat: integer): boolean; virtual;
  535.         procedure DDFinished(OrgID,WindID,mX,mY,KStat: integer); virtual;
  536.         procedure HandleDragDrop(PipeHnd,OrgID,WindID,mX,mY,KStat: integer); virtual;
  537.         procedure HandleKeybd(Stat,Key: integer); virtual;
  538.         procedure HandleButton(mX,mY,BStat,KStat,Clicks: integer); virtual;
  539.         procedure HandleM1(mX,mY,BStat,KStat: integer); virtual;
  540.         procedure HandleM2(mX,mY,BStat,KStat: integer); virtual;
  541.         procedure HandleMesag(Pipe: Pipearray); virtual;
  542.         procedure HandleAV(Pipe: Pipearray); virtual;
  543.         procedure HandleXAcc(Pipe: Pipearray); virtual;
  544.         procedure HandleTimer; virtual;
  545.         procedure HandleMenu(meNum: integer); virtual;
  546.         procedure HandleError; virtual;
  547.         procedure Terminate; virtual;
  548.         procedure Run; virtual;
  549.         procedure Quit; virtual;
  550.         function At(Index: integer): PWindow; virtual;
  551.         function IndexOf(Item: PWindow): integer; virtual;
  552.         function FirstWndThat(Test: PIterationFunc): PWindow; virtual;
  553.         procedure ForEachWnd(Action: PIterationProc); virtual;
  554.         procedure IconPaint(Work: GRECT; var PaintInfo: TPaintStruct); virtual;
  555.         procedure BubbleHelp(mX,mY: integer; Delay: word; Hlp: string); virtual;
  556.         function ExecDialog(ADialog: PDialog): integer; virtual;
  557.         function Alert(AParent: PWindow; DefBtn: integer; Sign: longint; Txt,Btn: string): integer; virtual;
  558.         function Popup(APopup: PPopup; x,y,Flag: integer): integer; virtual;
  559.         function Rubbox(WHnd,x,y,xmin,ymin,xmax,ymax: integer; var r: GRECT): boolean; virtual;
  560.         procedure InvalidateRect(Wnd: HWnd; Rect: PGRECT); virtual;
  561.         procedure RestoreModalDialog(p: PWindow); virtual;
  562.         procedure DeskRedraw; virtual;
  563.         procedure SetQuit(mNum,tNum: integer); virtual;
  564.         function ChkError: integer; virtual;
  565.         function ChkSpeedoError: integer; virtual;
  566.         procedure Error(ErrorCode: integer); virtual;
  567.         private
  568.         Err,
  569.         DlgTop   : integer;
  570.         termflag,
  571.         allicn,
  572.         ddokflag : boolean;
  573.         HMax     : HWnd;
  574.         mnusr    : USERBLK;
  575.         pquit    : PKeyMenu;
  576.         pcrswatch,
  577.         icnwnd   : PWindow;
  578.         wmnr     : HCursor;
  579.         wmform   : MFORM;
  580.         xaccname : PChar;
  581.         function getcval: longint;
  582.         function GetObjectParent(tree: PTree; indx: integer): integer;
  583.         function find_object(tree: PTree; start,which: integer): integer;
  584.         function ini_field(tree: PTree; start: integer): integer;
  585.         function form_keybd(fo_ktree: PTree; fo_kobject,fo_kobnext,fo_kchar: integer; var fo_knxtobject,fo_knxtchar: integer): integer;
  586.         function form_button(pd: PDialog; fo_bobject,fo_bclicks: integer; var fo_bnxtobj: integer): boolean;
  587.         procedure GOErrAlert(sign: integer; msg: string);
  588.         function XAccMR2HR(MR: string): string;
  589.         function AlertBubbleWrap(txt: string; width: integer): string;
  590.         procedure    FixResource(raddr: pointer; mode,what: boolean);
  591.         function MenuCorrect: boolean;
  592.         procedure MenuTune;
  593.     end;
  594.  
  595.     TDialog      = object(TWindow)
  596.         public
  597.         CtrlList      : PControl;
  598.         TransferBuffer: pointer;
  599.         IsModal,
  600.         Cont          : boolean;
  601.         Result        : integer;
  602.         constructor Init(AParent: PWindow; ATitle: string; Indx: integer);
  603.         destructor Done; virtual;
  604.         function GetStyle: integer; virtual;
  605.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  606.         function GetClassName: string; virtual;
  607.         function GetKBHandler: PEvent; virtual;
  608.         function IsDialog: boolean; virtual;
  609.         procedure LoadDialog(Indx: integer); virtual;
  610.         procedure UpdateDialog; virtual;
  611.         procedure SetupSize; virtual;
  612.         procedure SetupWindow; virtual;
  613.         procedure MakeWindow; virtual;
  614.         procedure Create; virtual;
  615.         procedure OpenWindow; virtual;
  616.         procedure CloseWindow; virtual;
  617.         procedure Destroy; virtual;
  618.         procedure Paint(var PaintInfo: TPaintStruct); virtual;
  619.         procedure ObjcPaint(Indx: integer; Lazy: boolean); virtual;
  620.         procedure GetWorkMax(var maxX,maxY: integer); virtual;
  621.         procedure WMClosed; virtual;
  622.         procedure WMButton(mX,mY,BStat,KStat,Clicks: integer); virtual;
  623.         procedure Execute; virtual;
  624.         procedure EndDlg(Indx: integer; DblClick: boolean); virtual;
  625.         procedure TransferData(Direction: word); virtual;
  626.         function ExitDlg(AnIndx: integer): boolean; virtual;
  627.         function OK: boolean; virtual;
  628.         function Cancel: boolean; virtual;
  629.         function Help: boolean; virtual;
  630.         function Undo: boolean; virtual;
  631.         function Esc: boolean; virtual;
  632.         function FirstThat(Test: PIterationFunc): PControl; virtual;
  633.         procedure ForEach(Action: PIterationProc); virtual;
  634.         procedure InitFocus; virtual;
  635.         procedure SetFocus(Obj: integer); virtual;
  636.         function GetFocus: integer; virtual;
  637.         procedure CallChanged(Indx: integer; dclk,edt,push: boolean); virtual;
  638.         private
  639.         edit_obj,
  640.         next_obj,
  641.         wmaxw,
  642.         wmaxh,
  643.         idx     : integer;
  644.         BValid,
  645.         d0fly,
  646.         bsave,
  647.         obedflag: boolean;
  648.         BackGr  : MFDB;
  649.         BLen,
  650.         frwid   : longint;
  651.         kbdh    : PEvent;
  652.         pedt    : PEdit;
  653.         procedure MoveDial(mX,mY: integer);
  654.         procedure SaveBackground;
  655.         procedure RestoreBackground;
  656.         function objc_edit(var ob_edchar: integer; ob_edkind: integer; clp: ARRAY_4; cclp: boolean): integer;
  657.     end;
  658.  
  659.     PToolbar     = ^TToolbar;
  660.     TToolbar     = object(TEvent)
  661.         public
  662.         ADialog : PDialog;
  663.         VKey,
  664.         VStat,
  665.         ObjTree,
  666.         ObjIndx : integer;
  667.         ObjAddr : PObj;
  668.         VPipe   : PPipearray;
  669.         VGHnd   : boolean;
  670.         constructor Init(AParent: PWindow; ATree,AnIndx,Stat,Key: integer; Msg: pointer; GetHnd,Switch: boolean; Hlp: string);
  671.         destructor Done; virtual;
  672.         function TestKey(Stat,Key: integer): boolean; virtual;
  673.         function TestMessage(Pipe: Pipearray): boolean; virtual;
  674.         function GetState: integer; virtual;
  675.         procedure SetState(StateFlag: integer); virtual;
  676.         procedure Disable; virtual;
  677.         procedure Enable; virtual;
  678.         procedure SetCheck(CheckFlag: integer); virtual;
  679.         function GetCheck: integer; virtual;
  680.         procedure Check; virtual;
  681.         procedure Uncheck; virtual;
  682.         procedure Toggle; virtual;
  683.         procedure Paint; virtual;
  684.         function IsHelpAvailable: boolean; virtual;
  685.         function GetHelp: string; virtual;
  686.         procedure SetHelp(Hlp: string); virtual;
  687.         private
  688.         IsSwitch: boolean;
  689.         BHelp   : PString
  690.     end;
  691.  
  692.     TKeyMenu     = object(TEvent)
  693.         public
  694.         ADialog: PDialog;
  695.         VStat,
  696.         VKey,
  697.         VMNum,
  698.         VTNum  : integer;
  699.         VPipe  : PPipearray;
  700.         VGHnd  : boolean;
  701.         constructor Init(AParent: PEventObject; Stat,Key,mNum,tNum: integer);
  702.         destructor Done; virtual;
  703.         function TestKey(Stat,Key: integer): boolean; virtual;
  704.         function TestMenu(mNum: integer): boolean; virtual;
  705.         function GetState: integer; virtual;
  706.         procedure SetState(StateFlag: integer); virtual;
  707.         procedure Disable; virtual;
  708.         procedure Enable; virtual;
  709.         function GetText: string; virtual;
  710.         procedure SetText(ATextString: string); virtual;
  711.         function GetCheck: integer; virtual;
  712.         procedure SetCheck(CheckFlag: integer); virtual;
  713.         procedure Check; virtual;
  714.         procedure Uncheck; virtual;
  715.         procedure Toggle; virtual;
  716.         private
  717.         function InitMWrk: boolean;
  718.         procedure ExitMWrk;
  719.     end;
  720.  
  721.     PKey         = ^TKey;
  722.     TKey         = object(TKeyMenu)
  723.         public
  724.         constructor Init(AParent: PEventObject; Stat,Key: integer; Msg: pointer; GetHnd: boolean);
  725.         function TestMenu(mNum: integer): boolean; virtual;
  726.     end;
  727.  
  728.     PMenu        = ^TMenu;
  729.     TMenu        = object(TKeyMenu)
  730.         public
  731.         constructor Init(AParent: PEventObject; mNum: integer; Msg: pointer; GetHnd: boolean);
  732.         function TestKey(Stat,Key: integer): boolean; virtual;
  733.     end;
  734.  
  735.  
  736. var
  737.  
  738.     Application: PApplication;
  739.     pxya       : ptsin_ARRAY;
  740.     SysInfo    : record
  741.         BGDefCol,
  742.         SFHeight,
  743.         SFWidth : integer
  744.     end;
  745.     GP         : record
  746.         charWidth,
  747.         charHeight,
  748.         boxWidth,
  749.         boxHeight,
  750.         horAlign,
  751.         verAlign,
  752.         wrmode,
  753.         ltype,
  754.         lwidth,
  755.         lcolor,
  756.         mtype,
  757.         mheight,
  758.         mcolor,
  759.         tpoint,
  760.         theight,
  761.         trotation,
  762.         teffects,
  763.         tcolor,
  764.         fstyle,
  765.         fcolor,
  766.         finterior,
  767.         fperimeter,
  768.         lendsb,
  769.         lendse,
  770.         ludsty,
  771.         font      : integer;
  772.         mnr       : HCursor;
  773.         mform     : MFORM;
  774.         clip      : ARRAY_4
  775.     end;
  776.  
  777.  
  778. procedure UpdateGPValues;
  779. function GEMVersion: word;
  780. function IsDesktopActive: boolean;
  781. procedure GetQSB(var p: pointer; var len: longint);
  782. function GetTempDir: string;
  783. function FileSelect(AParent: PWindow; ATitle,AMask: string; var APath,AFile: string; ForceExist: boolean): boolean;
  784. function OpenPrivateProfile(FileName: string): boolean;
  785. function SavePrivateProfile: boolean;
  786. function ClosePrivateProfile: boolean;
  787. function WritePrivateProfileString(AppName,KeyName,Value,FileName: string): boolean;
  788. function WritePrivateProfileInt(AppName,KeyName: string; Value: longint; FileName: string): boolean;
  789. function GetPrivateProfileString(AppName,KeyName,Default,FileName: string): string;
  790. function GetPrivateProfileInt(AppName,KeyName: string; Default: longint; FileName: string): longint;
  791. procedure vr_convert(handle: integer; psrcMFDB: MFDB; format: integer);
  792. procedure vdi_fix(var pfd: MFDB; theAddr: pointer; w,h: integer);
  793. function IsMouseVisible: boolean;
  794. function IsMouseBusy: boolean;
  795. procedure ShowMouse;
  796. procedure HideMouse;
  797. procedure ArrowMouse;
  798. procedure BusyMouse;
  799. procedure SliceMouse;
  800. procedure SliceMouseNext;
  801. procedure LastMouse;
  802.  
  803.  
  804. { Achtung: Auf die Existenz der folgenden Routinen im interface-Teil darf man
  805.            sich NICHT verlassen (sie sind auch nicht dokumentiert...)!!!      }
  806.  
  807. function graf_mouse(gr_monumber: word; gr_mofaddr: MFORMPtr): integer;
  808. function vswr_mode(handle,mode: integer): integer;
  809. procedure vsl_udsty(handle,pattern: integer);
  810. function vsl_type(handle,style: integer): integer;
  811. function vsl_width(handle,width: integer): integer;
  812. function vsl_color(handle,color_index: integer): integer;
  813. procedure vsl_ends(handle,beg_style,end_style: integer);
  814. function vsm_type(handle,symbol: integer): integer;
  815. function vsm_height(handle,height: integer): integer;
  816. function vsm_color(handle,color_index: integer): integer;
  817. function vst_font(handle,font: integer): integer;
  818. function vst_point(handle,point: integer; var char_width,char_height,cell_width,cell_height: integer): integer;
  819. procedure vst_height(handle,height: integer; var char_width,char_height,cell_width,cell_height: integer);
  820. function vst_rotation(handle,angle: integer): integer;
  821. function vst_effects(handle,effect: integer): integer;
  822. procedure vst_alignment(handle,hor_in,vert_in: integer; var hor_out,vert_out: integer);
  823. function vst_color(handle,color_index: integer): integer;
  824. function vsf_interior(handle,style: integer): integer;
  825. function vsf_style(handle,style_index: integer): integer;
  826. function vsf_color(handle,color_index: integer): integer;
  827. function vsf_perimeter(handle,per_vis: integer): integer;
  828. procedure vs_clip(handle,clipflag: integer; pxarray: ARRAY_4);
  829. procedure vr_trnfm(handle: integer; psrcMFDB,pdesMFDB: MFDB);
  830. procedure InitVWrk;
  831. procedure RestoreVWrk;
  832.  
  833.  
  834.  
  835. implementation
  836.  
  837. uses
  838.  
  839.     Strings;
  840.  
  841. const
  842.  
  843.     outlwidth          = 3;
  844.     Ctrl_Backdrop      = 25871;
  845.     Ctrl_Fuller        = 26122;
  846.     Ctrl_Iconify       = 28435;
  847.     GLOBAL             = $20;
  848.     MFORCE             = $8000;
  849.     FIXRSC             = true;
  850.     UNFIXRSC           = false;
  851.     FIX_ALL            = true;
  852.     FIX_BBONLY         = false;
  853.     POP_MAXROWS        = 19;
  854.     EDDRAW             = 42;
  855.     EDIDX              = 43;
  856.     EDIDXABS           = 44;
  857.     FMD_BACKWARD       = -1;
  858.     FMD_FORWARD        = -2;
  859.     FMD_DEFLT          = -3;
  860.     ICF_GETPOS         = $0001;
  861.     ICF_FREEPOS        = $0002;
  862.     RSC_LOADED         : pointer = pointer(1);
  863.     TEST_BEG_UPDATE    = BEG_UPDATE or $0100;
  864.  
  865. type
  866.  
  867.     INFOVSCRPtr        = ^INFOVSCR;
  868.     INFOVSCR           = record
  869.         cookie,
  870.         product: longint;
  871.         version: word;
  872.         x,y,w,h: integer
  873.     end;
  874.  
  875.     TedinfoArrayPtr    = ^TedinfoArray;
  876.     TedinfoArray       = array [0..9999] of TEDINFO;
  877.  
  878.     AESTreePtrArrayPtr = ^AESTreePtrArray;
  879.     AESTreePtrArray    = array [0..9999] of AESTreePtr;
  880.  
  881.     FreeStrPtrArrayPtr = ^FreeStrPtrArray;
  882.     FreeStrPtrArray    = array [0..9999] of PChar;
  883.  
  884.     FreeImgPtrArrayPtr = ^FreeImgPtrArray;
  885.     FreeImgPtrArray    = array [0..9999] of pointer;
  886.  
  887.     IconBlockArrayPtr  = ^IconBlockArray;
  888.     IconBlockArray     = array [0..9999] of ICONBLK;
  889.  
  890.     BitBlockArrayPtr   = ^BitBlockArray;
  891.     BitBlockArray      = array [0..9999] of BITBLK;
  892.  
  893.     PFUKey             = ^TFUKey;
  894.     TFUKey             = object(TKey)
  895.         function TestKey(Stat,Key: integer):boolean; virtual;
  896.     end;
  897.  
  898.     PWKey              = ^TWKey;
  899.     TWKey              = object(TKey)
  900.         function TestKey(Stat,Key: integer): boolean; virtual;
  901.     end;
  902.  
  903.     PDKey              = ^TDKey;
  904.     TDKey              = object(TEvent)
  905.         function TestKey(Stat,Key: integer): boolean; virtual;
  906.     end;
  907.  
  908.     PIKey              = ^TIKey;
  909.     TIKey              = object(TKey)
  910.         procedure Work; virtual;
  911.     end;
  912.  
  913.     PQKey              =  ^TQKey;
  914.     TQKey              =  object(TKeyMenu)
  915.         procedure Work; virtual;
  916.     end;
  917.  
  918.     PIcnWnd            = ^TIcnWnd;
  919.     TIcnWnd            = object(TWindow)
  920.         icx,icy,icw,ich: integer;
  921.         constructor Init(AParent: PWindow; ATitle: string; x,y,w,h: integer);
  922.         procedure MakeWindow; virtual;
  923.         procedure IconPaint(var PaintInfo: TPaintStruct); virtual;
  924.     end;
  925.  
  926.     PXAccCollection    = ^TXAccCollection;
  927.     TXAccCollection    = object(TCollection)
  928.         procedure FreeItem(Item: pointer); virtual;
  929.     end;
  930.  
  931.     PProfileCollection = ^TProfileCollection;
  932.     TProfileCollection = object(TCollection)
  933.         procedure FreeItem(Item: pointer); virtual;
  934.     end;
  935.  
  936. var
  937.  
  938.     OldExit,
  939.     icfserver      : pointer;
  940.     appdone,
  941.     profilechng    : boolean;
  942.     mhstack,mfstack,
  943.     spderr,bfalcol,
  944.     slmouse        : integer;
  945.     lastfa         : longint;
  946.     bbldelay       : word;
  947.     mlnr           : HCursor;
  948.     mlform         : MFORM;
  949.     DRect          : GRECT;
  950.     profile        : PProfileCollection;
  951.     profilename    : PString;
  952.  
  953.  
  954. function DrawTitle(dummy1,dummy2: pointer; parm: PARMBLKPtr): word; forward;
  955. function DrawStatic(dummy1,dummy2: pointer; parm: PARMBLKPtr): word; forward;
  956. function DrawMenuRect(dummy1,dummy2: pointer; parm: PARMBLKPtr): word; forward;
  957. function DrawPushButton(dummy1,dummy2: pointer; parm: PARMBLKPtr): word; forward;
  958. procedure SigHandler(dummy1,dummy2,sig: pointer); forward;
  959. procedure IconifyFadeout(p: PWindow); forward;
  960. procedure IconifyFadein(p: PWindow); forward;
  961. procedure SendXaccExit(p: PXAccAttr); forward;
  962.  
  963.  
  964.  
  965. { *** Objekt TEVENTOBJECT *** }
  966.  
  967. constructor TEventObject.Init;
  968.  
  969.   begin
  970.       if not(inherited Init) then fail;
  971.       EventList:=nil
  972.   end;
  973.  
  974.  
  975. destructor TEventObject.Done;
  976.  
  977.   begin
  978.         while (EventList<>nil) do EventList^.Free;
  979.         inherited Done
  980.   end;
  981.  
  982. { *** TEVENTOBJECT *** }
  983.  
  984.  
  985.  
  986. { *** Objekt TEVENT *** }
  987.  
  988. constructor TEvent.Init(AParent: PEventObject);
  989.     var p: PEvent;
  990.  
  991.     begin
  992.         if not(inherited Init) then fail;
  993.         Parent:=AParent;
  994.         if Parent=nil then Parent:=Application;
  995.         Prev:=nil;
  996.         Nxt:=nil;
  997.         if Parent^.EventList=nil then Parent^.EventList:=@self
  998.         else
  999.             begin
  1000.                 p:=Parent^.EventList;
  1001.                 while p^.Nxt<>nil do p:=p^.Nxt;
  1002.                 p^.Nxt:=@self;
  1003.                 Prev:=p
  1004.             end
  1005.     end;
  1006.  
  1007.  
  1008. destructor TEvent.Done;
  1009.  
  1010.     begin
  1011.         if (Prev=nil) and (Nxt=nil) then Parent^.EventList:=nil
  1012.         else
  1013.             begin
  1014.                 if Prev=nil then Parent^.EventList:=Nxt
  1015.                     else Prev^.Nxt:=Nxt;
  1016.                 if Nxt<>nil then Nxt^.Prev:=Prev
  1017.             end;
  1018.         inherited Done
  1019.     end;
  1020.  
  1021.  
  1022. function TEvent.TestKey(Stat,Key: integer): boolean;
  1023.  
  1024.     begin
  1025.         TestKey:=false
  1026.     end;
  1027.  
  1028.  
  1029. function TEvent.TestButton(mX,mY,BStat,KStat,Clicks: integer): boolean;
  1030.  
  1031.     begin
  1032.         TestButton:=false
  1033.     end;
  1034.  
  1035.  
  1036. function TEvent.TestMouse(M,mX,mY,BStat,KStat: integer): boolean;
  1037.  
  1038.     begin
  1039.         TestMouse:=false
  1040.     end;
  1041.  
  1042.  
  1043. function TEvent.TestMessage(Pipe: Pipearray): boolean;
  1044.  
  1045.     begin
  1046.         TestMessage:=false
  1047.     end;
  1048.  
  1049.  
  1050. function TEvent.TestMenu(mNum: integer): boolean;
  1051.  
  1052.     begin
  1053.         TestMenu:=false
  1054.     end;
  1055.  
  1056.  
  1057. procedure TEvent.Work;
  1058.  
  1059.     begin
  1060.     end;
  1061.  
  1062.  
  1063. function TEvent.Previous: PEvent;
  1064.  
  1065.     begin
  1066.         Previous:=Prev
  1067.     end;
  1068.  
  1069.  
  1070. function TEvent.Next: PEvent;
  1071.  
  1072.     begin
  1073.         Next:=Nxt
  1074.     end;
  1075.  
  1076. { *** TEVENT *** }
  1077.  
  1078.  
  1079.  
  1080. { *** Objekt TVALIDATOR *** }
  1081.  
  1082. constructor TValidator.Init;
  1083.  
  1084.     begin
  1085.         if not(inherited Init) then fail;
  1086.         Window:=nil;
  1087.         Status:=vsOK;
  1088.         Options:=0
  1089.     end;
  1090.  
  1091.  
  1092. procedure TValidator.Error;
  1093.  
  1094.     begin
  1095.         if Application<>nil then
  1096.             with Application^ do
  1097.                 begin
  1098.                     if (Attr.Country=FRG) or (Attr.Country=SWG) then
  1099.                         Alert(Window,1,NOTE,'Die Eingabe darf nicht leer sein!','  &OK  ')
  1100.                     else
  1101.                         Alert(Window,1,NOTE,'Input must not be empty!','  &OK  ')
  1102.             end
  1103.     end;
  1104.  
  1105.  
  1106. function TValidator.IsValid(s: string): boolean;
  1107.  
  1108.     begin
  1109.         if bTst(Options,voNotEmpty) then IsValid:=length(s)>0
  1110.         else
  1111.             IsValid:=true
  1112.     end;
  1113.  
  1114.  
  1115. function TValidator.IsValidInput(var s: string; SuppressFill: boolean): boolean;
  1116.  
  1117.     begin
  1118.         IsValidInput:=true
  1119.     end;
  1120.  
  1121.  
  1122. function TValidator.Valid(s: string): boolean;
  1123.  
  1124.     begin
  1125.         if IsValid(s) then Valid:=true
  1126.         else
  1127.             begin
  1128.                 Valid:=false;
  1129.                 Error
  1130.             end
  1131.     end;
  1132.  
  1133. { *** TVALIDATOR *** }
  1134.  
  1135.  
  1136.  
  1137. { *** Objekt TCONTROL *** }
  1138.  
  1139. constructor TControl.Init(AParent: PDialog; AnIndx: integer; Hlp: string);
  1140.     var p: PControl;
  1141.  
  1142.     begin
  1143.         if not(inherited Init) then fail;
  1144.         Parent:=AParent;
  1145.         if Parent=nil then
  1146.             begin
  1147.                 inherited Done;
  1148.                 fail
  1149.             end;
  1150.         ObjIndx:=AnIndx;
  1151.         ObjAddr:=@Parent^.DlgTree^[ObjIndx];
  1152.         if ObjAddr=nil then
  1153.             begin
  1154.                 inherited Done;
  1155.                 fail
  1156.             end;
  1157.         BHelp:=nil;
  1158.         SetHelp(Hlp);
  1159.         ID:=id_No;
  1160.         Style:=0;
  1161.         Flags:=0;
  1162.         Prev:=nil;
  1163.         Nxt:=nil;
  1164.         shortcut:=id_No;
  1165.         if Parent^.CtrlList=nil then Parent^.CtrlList:=@self
  1166.         else
  1167.             begin
  1168.                 p:=Parent^.CtrlList;
  1169.                 while p^.Nxt<>nil do p:=p^.Nxt;
  1170.                 p^.Nxt:=@self;
  1171.                 Prev:=p
  1172.             end
  1173.     end;
  1174.  
  1175.  
  1176. destructor TControl.Done;
  1177.  
  1178.     begin
  1179.         if (Prev=nil) and (Nxt=nil) then Parent^.CtrlList:=nil
  1180.         else
  1181.             begin
  1182.                 if Prev=nil then Parent^.CtrlList:=Nxt
  1183.                     else Prev^.Nxt:=Nxt;
  1184.                 if Nxt<>nil then Nxt^.Prev:=Prev
  1185.             end;
  1186.         DisposeStr(BHelp);
  1187.         inherited Done
  1188.     end;
  1189.  
  1190.  
  1191. function TControl.TestIndex(AnIndx: integer): boolean;
  1192.  
  1193.     begin
  1194.         TestIndex:=(AnIndx=ObjIndx)
  1195.     end;
  1196.  
  1197.  
  1198. function TControl.TestID(AnID: integer): boolean;
  1199.  
  1200.     begin
  1201.         TestID:=(AnID=ID)
  1202.     end;
  1203.  
  1204.  
  1205. function TControl.TestShortCut(Key: integer): boolean;
  1206.  
  1207.     begin
  1208.         TestShortCut:=(Key=shortcut)
  1209.     end;
  1210.  
  1211.  
  1212. procedure TControl.SetFlags(Mask: byte; OnOff: boolean);
  1213.  
  1214.     begin
  1215.         if OnOff then Flags:=Flags or Mask
  1216.         else
  1217.             Flags:=Flags and not(Mask)
  1218.     end;
  1219.  
  1220.  
  1221. function TControl.IsFlagSet(Mask: byte): boolean;
  1222.  
  1223.     begin
  1224.         IsFlagSet:=bTst(Flags,Mask)
  1225.     end;
  1226.  
  1227.  
  1228. procedure TControl.SetState(StateFlag: integer);
  1229.  
  1230.     begin
  1231.         if GetState<>StateFlag then
  1232.             begin
  1233.                 with ObjAddr^ do
  1234.                     if StateFlag=bf_Disabled then
  1235.                         ob_state:=ob_state or DISABLED
  1236.                     else
  1237.                         ob_state:=ob_state and not(DISABLED);
  1238.                 Paint
  1239.             end
  1240.     end;
  1241.  
  1242.  
  1243. function TControl.GetState: integer;
  1244.  
  1245.     begin
  1246.         if bTst(ObjAddr^.ob_state,DISABLED) then GetState:=bf_Disabled
  1247.         else
  1248.             GetState:=bf_Enabled
  1249.     end;
  1250.  
  1251.  
  1252. procedure TControl.Disable;
  1253.  
  1254.     begin
  1255.         SetState(bf_Disabled)
  1256.     end;
  1257.  
  1258.  
  1259. procedure TControl.Enable;
  1260.  
  1261.     begin
  1262.         SetState(bf_Enabled)
  1263.     end;
  1264.  
  1265.  
  1266. procedure TControl.SetColor(Color: integer);
  1267.     var ot: integer;
  1268.  
  1269.     begin
  1270.         if (Color<0) or (Color>15) then Color:=Black;
  1271.         if Color<>GetColor then
  1272.             begin
  1273.                 ot:=ObjAddr^.ob_type and $ff;
  1274.                 with ObjAddr^.ob_spec do
  1275.                     begin
  1276.                         if ot in [G_BOX,G_IBOX,G_BOXCHAR] then index:=(index and $fffff0ff) or (Color shl 8)
  1277.                         else
  1278.                             if ot in [G_TEXT,G_BOXTEXT,G_FTEXT,G_FBOXTEXT] then ted_info^.te_color:=(ted_info^.te_color and $f0ff) or (Color shl 8)
  1279.                             else
  1280.                                 if ot=G_ICON then icon_blk^.ib_char:=(icon_blk^.ib_char and $f0ff) or (Color shl 8)
  1281.                                 else
  1282.                                     if ot=G_IMAGE then bit_blk^.bi_color:=Color
  1283.                     end;
  1284.                 Paint
  1285.             end
  1286.     end;
  1287.  
  1288.  
  1289. function TControl.GetColor: integer;
  1290.     var ot: integer;
  1291.  
  1292.     begin
  1293.         GetColor:=Black;
  1294.         ot:=ObjAddr^.ob_type and $ff;
  1295.         if ot in [G_BOX,G_IBOX,G_BOXCHAR] then GetColor:=(ObjAddr^.ob_spec.index shr 8) and $0f
  1296.         else
  1297.             if ot in [G_TEXT,G_BOXTEXT,G_FTEXT,G_FBOXTEXT] then GetColor:=(ObjAddr^.ob_spec.ted_info^.te_color shr 8) and $0f
  1298.             else
  1299.                 if ot=G_ICON then GetColor:=(ObjAddr^.ob_spec.icon_blk^.ib_char shr 8) and $0f
  1300.                 else
  1301.                     if ot=G_IMAGE then GetColor:=ObjAddr^.ob_spec.bit_blk^.bi_color
  1302.     end;
  1303.  
  1304.  
  1305. procedure TControl.Hide(Draw: boolean);
  1306.  
  1307.     begin
  1308.         if not(IsHidden) then
  1309.             begin
  1310.                 with ObjAddr^ do ob_flags:=ob_flags or HIDETREE;
  1311.                 if Draw then
  1312.                     Parent^.ObjcPaint(Application^.GetObjectParent(Parent^.DlgTree,ObjIndx),bTst(Flags,wb_Lazy))
  1313.             end
  1314.     end;
  1315.  
  1316.  
  1317. procedure TControl.Unhide;
  1318.  
  1319.     begin
  1320.         if IsHidden then
  1321.             begin
  1322.                 with ObjAddr^ do ob_flags:=ob_flags and not(HIDETREE);
  1323.                 Paint
  1324.             end
  1325.     end;
  1326.  
  1327.  
  1328. function TControl.IsHidden: boolean;
  1329.  
  1330.     begin
  1331.         IsHidden:=bTst(ObjAddr^.ob_flags,HIDETREE)
  1332.     end;
  1333.  
  1334.  
  1335. procedure TControl.DisableTransfer;
  1336.  
  1337.     begin
  1338.         SetFlags(wb_Transfer,false)
  1339.     end;
  1340.  
  1341.  
  1342. procedure TControl.EnableTransfer;
  1343.  
  1344.     begin
  1345.         SetFlags(wb_Transfer,true)
  1346.     end;
  1347.  
  1348.  
  1349. function TControl.Transfer(DataPtr: pointer; TransferFlag: word): word;
  1350.  
  1351.     begin
  1352.         Transfer:=0
  1353.     end;
  1354.  
  1355.  
  1356. procedure TControl.Changed(AnIndx: integer; DblClick: boolean);
  1357.  
  1358.     begin
  1359.     end;
  1360.  
  1361.  
  1362. procedure TControl.Paint;
  1363.  
  1364.     begin
  1365.         Parent^.ObjcPaint(ObjIndx,bTst(Flags,wb_Lazy))
  1366.     end;
  1367.  
  1368.  
  1369. function TControl.IsHelpAvailable: boolean;
  1370.  
  1371.     begin
  1372.         if BHelp=nil then IsHelpAvailable:=false
  1373.         else
  1374.             IsHelpAvailable:=(length(StrPTrimF(BHelp^))<>0)
  1375.     end;
  1376.  
  1377.  
  1378. function TControl.GetHelp: string;
  1379.  
  1380.     begin
  1381.         if BHelp<>nil then GetHelp:=BHelp^ else GetHelp:=''
  1382.     end;
  1383.  
  1384.  
  1385. procedure TControl.SetHelp(Hlp: string);
  1386.  
  1387.     begin
  1388.         DisposeStr(BHelp);
  1389.         BHelp:=NewStr(Hlp)
  1390.     end;
  1391.  
  1392.  
  1393. function TControl.Previous: PControl;
  1394.  
  1395.     begin
  1396.         Previous:=Prev
  1397.     end;
  1398.  
  1399.  
  1400. function TControl.Next: PControl;
  1401.  
  1402.     begin
  1403.         Next:=Nxt
  1404.     end;
  1405.  
  1406. { *** TCONTROL *** }
  1407.  
  1408.  
  1409.  
  1410. { *** Objekt TBUTTON *** }
  1411.  
  1412. constructor TButton.Init(AParent: PDialog; AnIndx,AnID: integer; UserDef: boolean; Hlp: string);
  1413.  
  1414.     begin
  1415.         if not(inherited Init(AParent,AnIndx,Hlp)) then fail;
  1416.         Style:=cs_PushButton;
  1417.         with ObjAddr^ do
  1418.             begin
  1419.                 if bTst(ob_flags,DEFAULT) then Style:=Style or bs_DefPushButton;
  1420.                 ID:=AnID;
  1421.                 UsrDef:=UserDef;
  1422.                 if UsrDef then
  1423.                     begin
  1424.                         oldflags:=ob_flags;
  1425.                         oldstate:=ob_state;
  1426.                         if not(Install) then
  1427.                             begin
  1428.                                 inherited Done;
  1429.                                 fail
  1430.                             end
  1431.                     end;
  1432.                 if not(UsrDef) then
  1433.                     if (ID>=id_OK) and (ID<=id_Esc) then
  1434.                         if (ob_type and $ff)=G_BOXTEXT then
  1435.                             if Application^.Attr.Colors>=Yellow then
  1436.                                 with ob_spec.ted_info^ do
  1437.                                     te_color:=(te_color and $ff00) or $70 or Yellow;
  1438.                 SetText(GetRawText)
  1439.             end
  1440.     end;
  1441.  
  1442.  
  1443. destructor TButton.Done;
  1444.  
  1445.     begin
  1446.         if UsrDef then
  1447.             with ObjAddr^ do
  1448.                 begin
  1449.                     ob_spec.index:=UsrBlk.ub_parm;
  1450.                     ob_type:=G_BUTTON;
  1451.                     ob_state:=oldstate;
  1452.                     ob_flags:=oldflags;
  1453.                     inc(ob_x,5);
  1454.                     inc(ob_y,5);
  1455.                     dec(ob_width,10);
  1456.                     dec(ob_height,10)
  1457.                 end;
  1458.         inherited Done
  1459.     end;
  1460.  
  1461.  
  1462. function TButton.Install: boolean;
  1463.  
  1464.     begin
  1465.         with ObjAddr^ do
  1466.             if (ob_type and $ff)=G_BUTTON then
  1467.                 begin
  1468.                     UsrBlk.ub_parm:=ob_spec.index;
  1469.                     UsrBlk.ub_code:=@DrawPushButton;
  1470.                     ob_flags:=(ob_flags and not(RBUTTON or EDITABLE)) or SELECTABLE;
  1471.                     ob_state:=ob_state and not(CROSSED or CHECKED or OUTLINED or SHADOWED);
  1472.                     ob_type:=G_USERDEF;
  1473.                     ob_spec.user_blk:=@UsrBlk;
  1474.                     dec(ob_x,5);
  1475.                     dec(ob_y,5);
  1476.                     inc(ob_width,10);
  1477.                     inc(ob_height,10)
  1478.                 end
  1479.             else
  1480.                 UsrDef:=false;
  1481.         Install:=true
  1482.     end;
  1483.  
  1484.  
  1485. procedure TButton.SetText(ATextString: string);
  1486.     var typ,scpos: integer;
  1487.         adr      : PChar;
  1488.  
  1489.     begin
  1490.         adr:=nil;
  1491.         typ:=ObjAddr^.ob_type and $ff;
  1492.         scpos:=pos('&',ATextString);
  1493.         if (scpos>0) and (scpos<length(ATextString)) then
  1494.             begin
  1495.                 shortcut:=ord(upcase(ATextString[scpos+1]));
  1496.                 if not(UsrDef) then
  1497.                     ATextString:=StrPLeft(ATextString,scpos-1)+StrPRight(ATextString,length(ATextString)-scpos)
  1498.             end
  1499.         else
  1500.             shortcut:=id_No;
  1501.         if UsrDef then adr:=PChar(UsrBlk.ub_parm)
  1502.         else
  1503.             if (typ=G_BUTTON) or (typ=G_STRING) or (typ=G_TITLE) then
  1504.                 adr:=ObjAddr^.ob_spec.free_string;
  1505.         if adr<>nil then StrPCopy(adr,ATextString)
  1506.         else
  1507.             if (typ=G_TEXT) or (typ=G_BOXTEXT) or (typ=G_FTEXT) or (typ=G_FBOXTEXT) then
  1508.                 StrPCopy(ObjAddr^.ob_spec.ted_info^.te_ptext,ATextString);
  1509.         Paint
  1510.     end;
  1511.  
  1512.  
  1513. function TButton.GetText: string;
  1514.     var scpos: integer;
  1515.         txt  : string;
  1516.  
  1517.     begin
  1518.         txt:=GetRawText;
  1519.         scpos:=pos('&',txt);
  1520.         if scpos>0 then
  1521.             txt:=StrPLeft(txt,scpos-1)+StrPRight(txt,length(txt)-scpos);
  1522.         GetText:=txt
  1523.     end;
  1524.  
  1525.  
  1526.     { private }
  1527.  
  1528.  
  1529. function TButton.GetRawText: string;
  1530.     var typ: integer;
  1531.  
  1532.     begin
  1533.         if UsrDef then GetRawText:=StrPas(PChar(UsrBlk.ub_parm))
  1534.         else
  1535.             begin
  1536.                 typ:=ObjAddr^.ob_type and $ff;
  1537.                 if (typ=G_BUTTON) or (typ=G_STRING) or (typ=G_TITLE) then
  1538.                     GetRawText:=StrPas(ObjAddr^.ob_spec.free_string)
  1539.                 else
  1540.                     if (typ=G_TEXT) or (typ=G_BOXTEXT) or (typ=G_FTEXT) or (typ=G_FBOXTEXT) then
  1541.                         GetRawText:=StrPas(ObjAddr^.ob_spec.ted_info^.te_ptext)
  1542.                     else
  1543.                         GetRawText:=''
  1544.             end
  1545.     end;
  1546.  
  1547. { *** TBUTTON *** }
  1548.  
  1549.  
  1550.  
  1551. { *** Objekt TSTATIC *** }
  1552.  
  1553. constructor TStatic.Init(AParent: PDialog; AnIndx,ATextLen: integer; UserDef: boolean; Hlp: string);
  1554.  
  1555.     begin
  1556.         if not(inherited Init(AParent,AnIndx,Hlp)) then fail;
  1557.         Style:=cs_Static or sts_Fill;
  1558.         UsrDef:=false;
  1559.         usrused:=false;
  1560.         TextLen:=ATextLen;
  1561.         if TextLen<0 then TextLen:=0;
  1562.         if TextLen>256 then TextLen:=256;
  1563.         with ObjAddr^ do
  1564.             begin
  1565.                 oldtype:=ob_type and $ff;
  1566.                 oldflags:=ob_flags;
  1567.                 ob_flags:=ob_flags and not(RBUTTON or EDITABLE or SELECTABLE or DEFAULT or F_EXIT or TOUCHEXIT);
  1568.                 if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  1569.                     begin
  1570.                         UsrBlk.ub_parm:=ob_spec.index;
  1571.                         if UserDef=true then
  1572.                             begin
  1573.                                 UsrDef:=true;
  1574.                                 UsrBlk.ub_code:=@DrawTitle
  1575.                             end
  1576.                         else
  1577.                             begin
  1578.                                 usrused:=true;
  1579.                                 UsrBlk.ub_code:=@DrawStatic
  1580.                             end;
  1581.                         ob_type:=G_USERDEF;
  1582.                         ob_spec.user_blk:=@UsrBlk
  1583.                     end
  1584.                 else
  1585.                     if (oldtype<>G_TEXT) and (oldtype<>G_BOXTEXT) and (oldtype<>G_FTEXT) and (oldtype<>G_FBOXTEXT) then
  1586.                         begin
  1587.                             ob_flags:=oldflags;
  1588.                             inherited Done;
  1589.                             fail
  1590.                         end
  1591.                     else
  1592.                         if TextLen>ob_spec.ted_info^.te_txtlen then TextLen:=ob_spec.ted_info^.te_txtlen
  1593.             end
  1594.     end;
  1595.  
  1596.  
  1597. destructor TStatic.Done;
  1598.  
  1599.     begin
  1600.         with ObjAddr^ do
  1601.             begin
  1602.                 if UsrDef or usrused then
  1603.                     begin
  1604.                         ob_spec.index:=UsrBlk.ub_parm;
  1605.                         ob_type:=oldtype;
  1606.                     end;
  1607.                 ob_flags:=oldflags;
  1608.             end;
  1609.         inherited Done
  1610.     end;
  1611.  
  1612.  
  1613. function TStatic.Transfer(DataPtr: pointer; TransferFlag: word): word;
  1614.     var txt: string;
  1615.  
  1616.     begin
  1617.         case TransferFlag of
  1618.             tf_SetData: SetText(PString(DataPtr)^);
  1619.             tf_GetData: PString(DataPtr)^:=GetText
  1620.         end;
  1621.         if odd(TextLen) then Transfer:=TextLen+1
  1622.         else
  1623.             Transfer:=TextLen
  1624.     end;
  1625.  
  1626.  
  1627. procedure TStatic.SetText(ATextString: string);
  1628.     var adr: PChar;
  1629.  
  1630.     begin
  1631.         adr:=nil;
  1632.         if length(ATextString)>=TextLen then
  1633.             ATextString:=StrPLeft(ATextString,TextLen-1)
  1634.         else
  1635.             if bTst(Style,sts_Fill) then
  1636.                 ATextString:=ATextString+StrPSpace(TextLen-length(ATextString)-1);
  1637.         if UsrDef or usrused then adr:=PChar(UsrBlk.ub_parm)
  1638.         else
  1639.             if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  1640.                 adr:=ObjAddr^.ob_spec.free_string;
  1641.         if adr<>nil then StrPCopy(adr,ATextString)
  1642.         else
  1643.             begin
  1644.                 if ATextString[1]='@' then
  1645.                     begin
  1646.                         if bTst(Style,sts_Fill) then ATextString:=StrPSpace(TextLen-1)
  1647.                         else
  1648.                             ATextString:=''
  1649.                     end;
  1650.                 StrPCopy(ObjAddr^.ob_spec.ted_info^.te_ptext,ATextString)
  1651.             end;
  1652.         Paint
  1653.     end;
  1654.  
  1655.  
  1656. function TStatic.GetText: string;
  1657.     var txt: string;
  1658.  
  1659.     begin
  1660.         if UsrDef or usrused then txt:=StrPas(PChar(UsrBlk.ub_parm))
  1661.         else
  1662.             if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  1663.                 txt:=StrPas(ObjAddr^.ob_spec.free_string)
  1664.             else
  1665.                 begin
  1666.                     txt:=StrPas(ObjAddr^.ob_spec.ted_info^.te_ptext);
  1667.                     if txt[1]='@' then txt:=''
  1668.                 end;
  1669.         GetText:=StrPLeft(txt,TextLen-1)
  1670.     end;
  1671.  
  1672.  
  1673. function TStatic.GetTextLen: integer;
  1674.  
  1675.     begin
  1676.         GetTextLen:=length(GetText)
  1677.     end;
  1678.  
  1679.  
  1680. procedure TStatic.Clear;
  1681.  
  1682.     begin
  1683.         if bTst(Style,sts_Fill) then
  1684.             begin
  1685.                 if UsrDef or usrused then StrPCopy(PChar(UsrBlk.ub_parm),StrPSpace(TextLen-1))
  1686.                 else
  1687.                     if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  1688.                         StrPCopy(ObjAddr^.ob_spec.free_string,StrPSpace(TextLen-1))
  1689.                     else
  1690.                         setptext(Parent^.DlgTree,ObjIndx,StrPSpace(TextLen-1))
  1691.             end
  1692.         else
  1693.             begin
  1694.                 if UsrDef or usrused then PChar(UsrBlk.ub_parm)^:=#0
  1695.                 else
  1696.                     if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  1697.                         PChar(ObjAddr^.ob_spec.free_string)^:=#0
  1698.                     else
  1699.                         setptext(Parent^.DlgTree,ObjIndx,'')
  1700.             end;
  1701.         Paint
  1702.     end;
  1703.  
  1704. { *** TSTATIC *** }
  1705.  
  1706.  
  1707. { *** Objekt TEDIT *** }
  1708.  
  1709. constructor TEdit.Init(AParent: PDialog; AnIndx,ATextLen: integer; Hlp: string);
  1710.  
  1711.     begin
  1712.         if not(inherited Init(AParent,AnIndx,ATextLen,false,Hlp)) then fail;
  1713.         EnableTransfer;
  1714.         Style:=cs_Edit;
  1715.         if ((oldtype<>G_FTEXT) and (oldtype<>G_FBOXTEXT)) or (TextLen<2) then
  1716.             begin
  1717.                 inherited Done;
  1718.                 fail
  1719.             end;
  1720.         with ObjAddr^ do
  1721.             begin
  1722.                 ob_flags:=ob_flags or EDITABLE;
  1723.                 if bTst(Application^.Attr.Style,as_3DFlags) then ob_flags:=ob_flags or FL3DBAK
  1724.                 else
  1725.                     ob_flags:=ob_flags and not(FL3DBAK)
  1726.             end;
  1727.         Validator:=nil;
  1728.         UPtr:=nil;
  1729.         TPtr:=ChrNew(GetText);
  1730.         ClearModify;
  1731.         EdIdx:=id_No
  1732.     end;
  1733.  
  1734.  
  1735. destructor TEdit.Done;
  1736.  
  1737.     begin
  1738.         ChrDispose(TPtr);
  1739.         ChrDispose(UPtr);
  1740.         SetValidator(nil);
  1741.         inherited Done
  1742.     end;
  1743.  
  1744.  
  1745. procedure TEdit.SetText(ATextString: string);
  1746.     var dummy: integer;
  1747.  
  1748.     begin
  1749.         if not(Parent^.obedflag) then
  1750.             if Parent^.GetFocus=ObjIndx then
  1751.                 Parent^.objc_edit(dummy,EDEND,Parent^.Work.A2,true);
  1752.         inherited SetText(ATextString);
  1753.         if not(Parent^.obedflag) then
  1754.             if Parent^.GetFocus=ObjIndx then
  1755.                 Parent^.objc_edit(dummy,EDINIT,Parent^.Work.A2,true);
  1756.         ChrDispose(UPtr);
  1757.         UPtr:=TPtr;
  1758.         TPtr:=ChrNew(GetText);
  1759.         modified:=true
  1760.     end;
  1761.  
  1762.  
  1763. procedure TEdit.SetColor(Color: integer);
  1764.     var dummy: integer;
  1765.  
  1766.     begin
  1767.         if not(Parent^.obedflag) then
  1768.             if Parent^.GetFocus=ObjIndx then
  1769.                 Parent^.objc_edit(dummy,EDEND,Parent^.Work.A2,true);
  1770.         inherited SetColor(Color);
  1771.         if not(Parent^.obedflag) then
  1772.             if Parent^.GetFocus=ObjIndx then
  1773.                 Parent^.objc_edit(dummy,EDINIT,Parent^.Work.A2,true)
  1774.     end;
  1775.  
  1776.  
  1777. procedure TEdit.Edit;
  1778.     var valid     : boolean;
  1779.         old,cr,crc: string;
  1780.  
  1781.     begin
  1782.         valid:=true;
  1783.         if Validator<>nil then
  1784.             if bTst(Validator^.Options,voOnEdit) then
  1785.                 begin
  1786.                     old:=StrPas(TPtr);
  1787.                     cr:=GetText;
  1788.                     crc:=cr;
  1789.                     if not(Validator^.IsValidInput(cr,false)) then
  1790.                         begin
  1791.                             inherited SetText(old);
  1792.                             valid:=false
  1793.                         end
  1794.                     else
  1795.                         if crc<>cr then TStatic.SetText(cr)
  1796.                 end;
  1797.         if valid then
  1798.             begin
  1799.                 ChrDispose(UPtr);
  1800.                 UPtr:=TPtr;
  1801.                 TPtr:=ChrNew(GetText);
  1802.                 modified:=true
  1803.             end
  1804.     end;
  1805.  
  1806.  
  1807. function TEdit.IsValid(ReportError: boolean): boolean;
  1808.  
  1809.     begin
  1810.         if Validator<>nil then
  1811.             begin
  1812.                 if ReportError then IsValid:=Validator^.Valid(GetText)
  1813.                 else
  1814.                     IsValid:=Validator^.IsValid(GetText)
  1815.             end
  1816.         else
  1817.             IsValid:=true
  1818.     end;
  1819.  
  1820.  
  1821. function TEdit.CanClose: boolean;
  1822.  
  1823.     begin
  1824.         CanClose:=true;
  1825.         if GetState<>bf_Disabled then
  1826.             if not(IsValid(true)) then
  1827.                 begin
  1828.                     CanClose:=false;
  1829.                     Focus
  1830.                 end
  1831.     end;
  1832.  
  1833.  
  1834. function TEdit.CanUndo: boolean;
  1835.  
  1836.     begin
  1837.         CanUndo:=(UPtr<>nil)
  1838.     end;
  1839.  
  1840.  
  1841. procedure TEdit.Undo;
  1842.  
  1843.     begin
  1844.         if UPtr<>nil then SetText(StrLPas(UPtr,TextLen-1))
  1845.     end;
  1846.  
  1847.  
  1848. procedure TEdit.Paste;
  1849.  
  1850.     begin
  1851.     end;
  1852.  
  1853.  
  1854. procedure TEdit.Copy;
  1855.  
  1856.     begin
  1857.     end;
  1858.  
  1859.  
  1860. procedure TEdit.Cut;
  1861.  
  1862.     begin
  1863.     end;
  1864.  
  1865.  
  1866. procedure TEdit.Focus;
  1867.  
  1868.     begin
  1869.         Parent^.SetFocus(ObjIndx)
  1870.     end;
  1871.  
  1872.  
  1873. function TEdit.IsModified: boolean;
  1874.  
  1875.     begin
  1876.         IsModified:=modified
  1877.     end;
  1878.  
  1879.  
  1880. procedure TEdit.ClearModify;
  1881.  
  1882.     begin
  1883.         modified:=false
  1884.     end;
  1885.  
  1886.  
  1887. procedure TEdit.SetValidator(AValid: PValidator);
  1888.  
  1889.     begin
  1890.         if Validator<>nil then Validator^.Free;
  1891.         Validator:=AValid;
  1892.         if Validator<>nil then Validator^.Window:=Parent
  1893.     end;
  1894.  
  1895.  
  1896. procedure TEdit.SetCursor(CPos: integer);
  1897.     var maxidx: integer;
  1898.  
  1899.     begin
  1900.         maxidx:=StrLen(ObjAddr^.ob_spec.ted_info^.te_ptext);
  1901.         if (CPos<0) or (CPos>maxidx) then CPos:=maxidx;
  1902.         EdIdx:=CPos;
  1903.         with Parent^ do
  1904.             if GetFocus=ObjIndx then
  1905.                 if Attr.Status=ws_Open then
  1906.                     objc_edit(EdIdx,EDIDXABS,Work.A2,true)
  1907.     end;
  1908.  
  1909.  
  1910. function TEdit.GetCursor: integer;
  1911.  
  1912.     begin
  1913.         GetCursor:=EdIdx
  1914.     end;
  1915.  
  1916. { *** TEDIT *** }
  1917.  
  1918.  
  1919.  
  1920. { *** Objekt TPOPUP *** }
  1921.  
  1922. constructor TPopup.Init(AParent: PEventObject; tIndx,oIndx: integer);
  1923.     var valid: boolean;
  1924.         q    : integer;
  1925.  
  1926.     begin
  1927.         if not(inherited Init(AParent)) then fail;
  1928.         PopTree:=Application^.GetAddr(tIndx);
  1929.         if PopTree=nil then
  1930.             begin
  1931.                 inherited Done;
  1932.                 fail
  1933.             end;
  1934.         valid:=true;
  1935.         for q:=PopTree^[oIndx].ob_head to PopTree^[oIndx].ob_tail do
  1936.             if PopTree^[q].ob_type<>G_STRING then valid:=false;
  1937.         if PopTree^[oIndx].ob_type<>G_BOX then valid:=false;
  1938.         pMax:=PopTree^[oIndx].ob_tail+1-PopTree^[oIndx].ob_head;
  1939.         pRows:=pMax;
  1940.         if (pRows>POP_MAXROWS) or not(valid) then
  1941.             begin
  1942.                 inherited Done;
  1943.                 fail
  1944.             end;
  1945.         pFlag:=POP_LEFTOP;
  1946.         pIndex:=oIndx;
  1947.         pX:=0;
  1948.         pY:=0
  1949.     end;
  1950.  
  1951.  
  1952. function TPopup.Execute: integer;
  1953.     label _error,_upagain,_dnagain;
  1954.  
  1955.     var scrn,memr        : MFDB;
  1956.         q,mx,my,ms,mc,obj: integer;
  1957.         evnt,key,kstat   : integer;
  1958.         fmf              : word;
  1959.         blen,ql          : longint;
  1960.         qp               : pointer;
  1961.         qused            : boolean;
  1962.         pipe             : Pipearray;
  1963.         vrec             : ARRAY_4;
  1964.         box              : GRECT;
  1965.         spec             : array [0..POP_MAXROWS-1] of OBSPEC;
  1966.         pxy              : record
  1967.                              case integer of
  1968.                                0: (b8     : ARRAY_8);
  1969.                                1: (b41,b42: ARRAY_4)
  1970.                            end;
  1971.  
  1972.     procedure MouseSim(sobj: integer);
  1973.         var arec: APPLRECORD;
  1974.  
  1975.         begin
  1976.             if GEMVersion>=$0120 then
  1977.                 begin
  1978.                     arec.Typ:=AT_MOUSE;
  1979.                     arec.What.Hi:=PopTree^[pIndex].ob_x+PopTree^[PopTree^[pIndex].ob_head+sobj].ob_x+(PopTree^[PopTree^[pIndex].ob_head+sobj].ob_width shr 1);
  1980.                     arec.What.Lo:=PopTree^[pIndex].ob_y+PopTree^[PopTree^[pIndex].ob_head+sobj].ob_y+(PopTree^[PopTree^[pIndex].ob_head+sobj].ob_height shr 1);
  1981.                     appl_tplay(@arec,1,10000)
  1982.                 end
  1983.         end;
  1984.  
  1985.     function isanyenabled: boolean;
  1986.         var q: integer;
  1987.  
  1988.         begin
  1989.             isanyenabled:=false;
  1990.             for q:=0 to pRows-1 do
  1991.                 if GetState(q)=bf_Enabled then
  1992.                     begin
  1993.                         isanyenabled:=true;
  1994.                         exit
  1995.                     end
  1996.         end;
  1997.  
  1998.     begin
  1999.         Execute:=id_No;
  2000.         if PopTree=nil then exit;
  2001.         wind_update(BEG_UPDATE);
  2002.         wind_update(BEG_MCTRL);
  2003.         fmf:=ARROW;
  2004.         if Application^.MultiTOS then fmf:=fmf or MFORCE;
  2005.         gem.graf_mouse(fmf,nil);
  2006.         mnusr.ub_parm:=0;
  2007.         mnusr.ub_code:=@DrawMenuRect;
  2008.         for q:=PopTree^[pIndex].ob_head to PopTree^[pIndex].ob_tail do
  2009.             begin
  2010.                 PopTree^[q].ob_flags:=SELECTABLE;
  2011.                 PopTree^[q].ob_state:=PopTree^[q].ob_state and (DISABLED or CHECKED);
  2012.                 spec[q-PopTree^[pIndex].ob_head]:=PopTree^[q].ob_spec;
  2013.                 if bTst(PopTree^[q].ob_state,DISABLED) then
  2014.                     if PChar(PopTree^[q].ob_spec.free_string)^='-' then
  2015.                         begin
  2016.                             PopTree^[q].ob_type:=G_USERDEF;
  2017.                             PopTree^[q].ob_spec.user_blk:=@mnusr
  2018.                         end
  2019.             end;
  2020.         with PopTree^[pIndex] do
  2021.             begin
  2022.                 ob_state:=SHADOWED;
  2023.                 ob_x:=pX;
  2024.                 ob_y:=pY;
  2025.                 if pFlag=POP_CENTER then
  2026.                     begin
  2027.                         dec(ob_x,ob_width shr 1);
  2028.                         dec(ob_y,ob_height shr 1)
  2029.                     end;
  2030.                 if ob_x+ob_width>DRect.X2 then ob_x:=DRect.X2-ob_width;
  2031.                 if ob_y+ob_height>DRect.Y2 then ob_y:=DRect.Y2-ob_height;
  2032.                 if ob_x<=DRect.X1 then ob_x:=DRect.X1+1;
  2033.                 if ob_y<=DRect.Y1 then ob_y:=DRect.Y1+1;
  2034.                 box.X:=ob_x-outlwidth;
  2035.                 box.Y:=ob_y-outlwidth;
  2036.                 box.W:=ob_width+(outlwidth shl 1);
  2037.                 box.H:=ob_height+(outlwidth shl 1)
  2038.             end;
  2039.         HideMouse;
  2040.         if not(rc_intersect(DRect,box)) then goto _error;
  2041.         with memr do
  2042.             begin
  2043.                 fd_w:=box.W;
  2044.                 fd_h:=box.H;
  2045.                 fd_stand:=FF_DEVSPEC;
  2046.                 fd_wdwidth:=(fd_w+15) shr 4;
  2047.                 fd_nplanes:=Application^.Attr.Planes;
  2048.                 blen:=(longint(fd_wdwidth)*longint(fd_h)*longint(fd_nplanes)) shl 1
  2049.             end;
  2050.         if Application^.IsQSBUsed then ql:=-1
  2051.         else
  2052.             GetQSB(qp,ql);
  2053.         qused:=(ql>=blen);
  2054.         if qused then
  2055.             begin
  2056.                 memr.fd_addr:=qp;
  2057.                 Application^.IsQSBUsed:=true
  2058.             end
  2059.         else
  2060.             getmem(memr.fd_addr,blen);
  2061.         if memr.fd_addr=nil then goto _error;
  2062.         scrn.fd_addr:=nil;
  2063.         pxy.b8[0]:=box.X;
  2064.         pxy.b8[1]:=box.Y;
  2065.         pxy.b8[2]:=box.X+box.W-1;
  2066.         pxy.b8[3]:=box.Y+box.H-1;
  2067.         pxy.b8[4]:=0;
  2068.         pxy.b8[5]:=0;
  2069.         pxy.b8[6]:=memr.fd_w-1;
  2070.         pxy.b8[7]:=memr.fd_h-1;
  2071.         vro_cpyfm(Application^.vdiHandle,S_ONLY,pxy.b8,scrn,memr);
  2072.         objc_draw(PopTree,pIndex,MAX_DEPTH,DRect.X,DRect.Y,DRect.W,DRect.H);
  2073.         ShowMouse;
  2074.         obj:=id_No;
  2075.         graf_mkstate(mx,my,mc,q);
  2076.         mc:=mc and 1;
  2077.         repeat
  2078.             q:=objc_find(PopTree,pIndex,MAX_DEPTH,mx,my);
  2079.             if (q<>obj) and (q<>pIndex) then
  2080.                 begin
  2081.                     if obj>0 then
  2082.                         begin
  2083.                             PopTree^[obj].ob_state:=PopTree^[obj].ob_state and not(SELECTED);
  2084.                             vrec[0]:=PopTree^[obj].ob_x+PopTree^[pIndex].ob_x;
  2085.                             vrec[1]:=PopTree^[obj].ob_y+PopTree^[pIndex].ob_y;
  2086.                             vrec[2]:=vrec[0]+PopTree^[obj].ob_width-1;
  2087.                             vrec[3]:=vrec[1]+PopTree^[obj].ob_height-1;
  2088.                             HideMouse;
  2089.                             with Application^ do
  2090.                                 begin
  2091.                                     gem.vswr_mode(vdiHandle,MD_REPLACE);
  2092.                                     gem.vsf_interior(vdiHandle,FIS_HOLLOW);
  2093.                                     vr_recfl(vdiHandle,vrec);
  2094.                                     gem.vswr_mode(vdiHandle,GP.wrmode);
  2095.                                     gem.vsf_interior(vdiHandle,GP.finterior)
  2096.                                 end;
  2097.                             objc_draw(PopTree,obj,MAX_DEPTH,DRect.X,DRect.Y,DRect.W,DRect.H);
  2098.                             ShowMouse
  2099.                         end;
  2100.                     obj:=id_No;
  2101.                     if q>0 then
  2102.                         if not(bTst(PopTree^[q].ob_state,DISABLED)) then
  2103.                             begin
  2104.                                 obj:=q;
  2105.                                 PopTree^[obj].ob_state:=PopTree^[obj].ob_state or SELECTED;
  2106.                                 HideMouse;
  2107.                                 objc_draw(PopTree,obj,MAX_DEPTH,DRect.X,DRect.Y,DRect.W,DRect.H);
  2108.                                 ShowMouse
  2109.                             end
  2110.                 end;
  2111.             evnt:=evnt_multi(MU_KEYBD or MU_TIMER,257,3,0,0,0,0,0,0,0,0,0,0,0,pipe,1,0,mx,my,ms,kstat,key,q);
  2112.             if bTst(ms,2) then
  2113.                 begin
  2114.                     evnt:=MU_KEYBD;
  2115.                     key:=S_Esc
  2116.                 end;
  2117.             if bTst(evnt,MU_KEYBD) then
  2118.                 case key of
  2119.                     Return,Enter,$3920: ms:=mc xor 1;
  2120.                     S_Esc,S_Undo: begin
  2121.                                                     if obj>0 then PopTree^[obj].ob_state:=PopTree^[obj].ob_state and not(SELECTED);
  2122.                                                     obj:=id_No;
  2123.                                                     ms:=mc xor 1
  2124.                                                 end;
  2125.                     Home: if isanyenabled then
  2126.                                     begin
  2127.                                         q:=0;
  2128.                                         while GetState(q)=bf_Disabled do inc(q);
  2129.                                         MouseSim(q)
  2130.                                     end;
  2131.                     Shift_Home: if isanyenabled then
  2132.                                                 begin
  2133.                                                     q:=pRows-1;
  2134.                                                     while GetState(q)=bf_Disabled do dec(q);
  2135.                                                     MouseSim(q)
  2136.                                                 end;
  2137.                     Cur_Up: if isanyenabled then
  2138.                                         begin
  2139.                                             if obj>0 then
  2140.                                                 begin
  2141.                                                     q:=obj-PopTree^[pIndex].ob_head-1;
  2142.                                                     _upagain:
  2143.                                                     if q>=0 then
  2144.                                                         if GetState(q)=bf_Disabled then
  2145.                                                             begin
  2146.                                                                 dec(q);
  2147.                                                                 goto _upagain
  2148.                                                             end;
  2149.                                                     if q<0 then
  2150.                                                         begin
  2151.                                                             q:=pRows-1;
  2152.                                                             goto _upagain
  2153.                                                         end;
  2154.                                                     MouseSim(q)
  2155.                                                 end
  2156.                                             else
  2157.                                                 begin
  2158.                                                     q:=pRows-1;
  2159.                                                     while GetState(q)=bf_Disabled do dec(q);
  2160.                                                     MouseSim(q)
  2161.                                                 end
  2162.                                         end;
  2163.                     Cur_Down: if isanyenabled then
  2164.                                             begin
  2165.                                                 if obj>0 then
  2166.                                                     begin
  2167.                                                         q:=obj+1-PopTree^[pIndex].ob_head;
  2168.                                                         _dnagain:
  2169.                                                         if q<pRows then
  2170.                                                             if GetState(q)=bf_Disabled then
  2171.                                                                 begin
  2172.                                                                     inc(q);
  2173.                                                                     goto _dnagain
  2174.                                                                 end;
  2175.                                                         if q>=pRows then
  2176.                                                             begin
  2177.                                                                 q:=0;
  2178.                                                                 goto _dnagain
  2179.                                                             end;
  2180.                                                         MouseSim(q)
  2181.                                                     end
  2182.                                                 else
  2183.                                                     begin
  2184.                                                         q:=0;
  2185.                                                         while GetState(q)=bf_Disabled do inc(q);
  2186.                                                         MouseSim(q)
  2187.                                                     end
  2188.                                             end
  2189.                 end
  2190.         until ms<>mc;
  2191.         if obj>0 then
  2192.             begin
  2193.                 PopTree^[obj].ob_state:=PopTree^[obj].ob_state and not(SELECTED);
  2194.                 Execute:=obj-PopTree^[pIndex].ob_head
  2195.             end
  2196.         else
  2197.             Execute:=id_No;
  2198.         HideMouse;
  2199.         scrn.fd_addr:=nil;
  2200.         vrec:=pxy.b41;
  2201.         pxy.b41:=pxy.b42;
  2202.         pxy.b42:=vrec;
  2203.         vro_cpyfm(Application^.vdiHandle,S_ONLY,pxy.b8,memr,scrn);
  2204.         if qused then Application^.IsQSBUsed:=false
  2205.         else
  2206.             freemem(memr.fd_addr,blen);
  2207.         _error:
  2208.         ShowMouse;
  2209.         for q:=PopTree^[pIndex].ob_head to PopTree^[pIndex].ob_tail do
  2210.             begin
  2211.                 PopTree^[q].ob_spec:=spec[q-PopTree^[pIndex].ob_head];
  2212.                 PopTree^[q].ob_type:=G_STRING
  2213.             end;
  2214.         gem.graf_mouse(GP.mnr,@GP.mform);
  2215.         repeat
  2216.             graf_mkstate(mx,my,ms,q)
  2217.         until ms=0;
  2218.         wind_update(END_MCTRL);
  2219.         wind_update(END_UPDATE)
  2220.     end;
  2221.  
  2222.  
  2223. procedure TPopup.SetText(nr: integer; ATextString: string);
  2224.  
  2225.     begin
  2226.         if (nr>=0) and (nr<pRows) then
  2227.             StrPCopy(PopTree^[nr+PopTree^[pIndex].ob_head].ob_spec.free_string,ATextString)
  2228.     end;
  2229.  
  2230.  
  2231. function TPopup.GetText(nr: integer): string;
  2232.  
  2233.     begin
  2234.         if (nr>=0) and (nr<pRows) then
  2235.             GetText:=StrPas(PopTree^[nr+PopTree^[pIndex].ob_head].ob_spec.free_string)
  2236.         else
  2237.             GetText:=''
  2238.     end;
  2239.  
  2240.  
  2241. procedure TPopup.SetState(nr,StateFlag: integer);
  2242.  
  2243.     begin
  2244.         if (nr>=0) and (nr<pRows) then
  2245.             begin
  2246.                 if StateFlag=bf_Disabled then PopTree^[nr+PopTree^[pIndex].ob_head].ob_state:=PopTree^[nr+PopTree^[pIndex].ob_head].ob_state or DISABLED
  2247.                 else
  2248.                     PopTree^[nr+PopTree^[pIndex].ob_head].ob_state:=PopTree^[nr+PopTree^[pIndex].ob_head].ob_state and not(DISABLED)
  2249.             end
  2250.     end;
  2251.  
  2252.  
  2253. function TPopup.GetState(nr: integer): integer;
  2254.  
  2255.     begin
  2256.         if (nr>=0) and (nr<pRows) then
  2257.             begin
  2258.                 if bTst(PopTree^[nr+PopTree^[pIndex].ob_head].ob_state,DISABLED) then GetState:=bf_Disabled
  2259.                 else
  2260.                     GetState:=bf_Enabled
  2261.             end
  2262.         else
  2263.             GetState:=id_No
  2264.     end;
  2265.  
  2266.  
  2267. procedure TPopup.Disable(nr: integer);
  2268.  
  2269.     begin
  2270.         SetState(nr,bf_Disabled)
  2271.     end;
  2272.  
  2273.  
  2274. procedure TPopup.Enable(nr: integer);
  2275.  
  2276.     begin
  2277.         SetState(nr,bf_Enabled)
  2278.     end;
  2279.  
  2280.  
  2281. procedure TPopup.SetCheck(nr,CheckFlag: integer);
  2282.  
  2283.     begin
  2284.         if (nr>=0) and (nr<pRows) then
  2285.             begin
  2286.                 if CheckFlag=bf_Checked then PopTree^[nr+PopTree^[pIndex].ob_head].ob_state:=PopTree^[nr+PopTree^[pIndex].ob_head].ob_state or CHECKED
  2287.                 else
  2288.                     PopTree^[nr+PopTree^[pIndex].ob_head].ob_state:=PopTree^[nr+PopTree^[pIndex].ob_head].ob_state and not(CHECKED)
  2289.             end
  2290.     end;
  2291.  
  2292.  
  2293. function TPopup.GetCheck(nr: integer): integer;
  2294.  
  2295.     begin
  2296.         if (nr>=0) and (nr<pRows) then
  2297.             begin
  2298.                 if bTst(PopTree^[nr+PopTree^[pIndex].ob_head].ob_state,CHECKED) then GetCheck:=bf_Checked
  2299.                 else
  2300.                     GetCheck:=bf_Unchecked
  2301.             end
  2302.         else
  2303.             GetCheck:=id_No
  2304.     end;
  2305.  
  2306.  
  2307. procedure TPopup.Check(nr: integer);
  2308.  
  2309.     begin
  2310.         SetCheck(nr,bf_Checked)
  2311.     end;
  2312.  
  2313.  
  2314. procedure TPopup.Uncheck(nr: integer);
  2315.  
  2316.     begin
  2317.         SetCheck(nr,bf_Unchecked)
  2318.     end;
  2319.  
  2320.  
  2321. procedure TPopup.Toggle(nr: integer);
  2322.  
  2323.     begin
  2324.         if GetCheck(nr)=bf_Unchecked then SetCheck(nr,bf_Checked)
  2325.         else
  2326.             SetCheck(nr,bf_Unchecked)
  2327.     end;
  2328.  
  2329. { *** TPOPUP *** }
  2330.  
  2331.  
  2332.  
  2333. { *** Objekt TSCROLLER *** }
  2334.  
  2335. constructor TScroller.Init(TheWindow: PWindow; TheXUnit,TheYUnit: integer; TheXRange,TheYRange: longint);
  2336.  
  2337.     begin
  2338.         if not(inherited Init) then fail;
  2339.         Window:=TheWindow;
  2340.         if Window=nil then
  2341.             begin
  2342.                 inherited Done;
  2343.                 fail
  2344.             end;
  2345.         Window^.Scroller:=@self;
  2346.         TrackMode:=true;
  2347.         HasVScrollBar:=bTst(Window^.Attr.Style,VSLIDE);
  2348.         HasHScrollBar:=bTst(Window^.Attr.Style,HSLIDE);
  2349.         XLine:=1;
  2350.         YLine:=1;
  2351.         XPos:=0;
  2352.         YPos:=0;
  2353.         XUnit:=TheXUnit;
  2354.         YUnit:=TheYUnit;
  2355.         if XUnit<1 then XUnit:=1;
  2356.         if YUnit<1 then YUnit:=1;
  2357.         SetPageSize;
  2358.         SetRange(TheXRange,TheYRange)
  2359.     end;
  2360.  
  2361.  
  2362. destructor TScroller.Done;
  2363.  
  2364.     begin
  2365.         Window^.Scroller:=nil;
  2366.         inherited Done
  2367.     end;
  2368.  
  2369.  
  2370. procedure TScroller.HScroll;
  2371.     var dif: longint;
  2372.  
  2373.     begin
  2374.         if HasHScrollBar then
  2375.             begin
  2376.                 dif:=XRange-XPage-1;
  2377.                 if dif<1 then dif:=1;
  2378.                 dif:=(1000*XPos) div dif;
  2379.                 if dif>1000 then dif:=1000;
  2380.                 with Window^.Attr do
  2381.                     if gemHandle>=0 then
  2382.                         wind_set(gemHandle,WF_HSLIDE,dif,0,0,0)
  2383.             end
  2384.     end;
  2385.  
  2386.  
  2387. procedure TScroller.VScroll;
  2388.     var dif: longint;
  2389.  
  2390.     begin
  2391.         if HasVScrollBar then
  2392.             begin
  2393.                 dif:=YRange-YPage-1;
  2394.                 if dif<1 then dif:=1;
  2395.                 dif:=(1000*YPos) div dif;
  2396.                 if dif>1000 then dif:=1000;
  2397.                 with Window^.Attr do
  2398.                     if gemHandle>=0 then
  2399.                         wind_set(gemHandle,WF_VSLIDE,dif,0,0,0)
  2400.             end
  2401.     end;
  2402.  
  2403.  
  2404. function TScroller.IsVisibleRect(X,Y,XExt,YExt: longint): boolean;
  2405.     var r: GRECT;
  2406.  
  2407.     begin
  2408.         r.X:=(X-XPos)*XUnit+Window^.Work.X;
  2409.         r.Y:=(Y-YPos)*YUnit+Window^.Work.Y;
  2410.         r.W:=XExt*XUnit;
  2411.         r.H:=YExt*YUnit;
  2412.         IsVisibleRect:=rc_intersect(Window^.Work,r)
  2413.     end;
  2414.  
  2415.  
  2416. procedure TScroller.ScrollBy(dX,dY: longint);
  2417.     var pw,ph: integer;
  2418.  
  2419.     begin
  2420.         inc(dX,XPos);
  2421.         inc(dY,YPos);
  2422.         pw:=Window^.Work.W div XUnit;
  2423.         ph:=Window^.Work.H div YUnit;
  2424.         if dX+pw>=XRange then dX:=XRange-pw-1;
  2425.         if dY+ph>=YRange then dY:=YRange-ph-1;
  2426.         if dX<0 then dX:=0;
  2427.         if dY<0 then dY:=0;
  2428.         if (dX<>XPos) or (dY<>YPos) then
  2429.             begin
  2430.                 if dX<>XPos then
  2431.                     begin
  2432.                         XPos:=dX;
  2433.                         HScroll
  2434.                     end;
  2435.                 if dY<>YPos then
  2436.                     begin
  2437.                         YPos:=dY;
  2438.                         VScroll
  2439.                     end;
  2440.                 if TrackMode then
  2441.                     begin
  2442.                         wind_update(BEG_UPDATE);
  2443.                         with Window^ do WMRedraw(Work.X,Work.Y,Work.W,Work.H);
  2444.                         wind_update(END_UPDATE)
  2445.                     end
  2446.                 else
  2447.                     Window^.ForceRedraw
  2448.             end
  2449.     end;
  2450.  
  2451.  
  2452. procedure TScroller.ScrollTo(X,Y: longint);
  2453.     var pw,ph: integer;
  2454.  
  2455.     begin
  2456.         pw:=Window^.Work.W div XUnit;
  2457.         ph:=Window^.Work.H div YUnit;
  2458.         if X+pw>=XRange then X:=XRange-pw-1;
  2459.         if Y+ph>=YRange then Y:=YRange-ph-1;
  2460.         if X<0 then X:=0;
  2461.         if Y<0 then Y:=0;
  2462.         if (X<>XPos) or (Y<>YPos) then
  2463.             begin
  2464.                 if X<>XPos then
  2465.                     begin
  2466.                         XPos:=X;
  2467.                         HScroll
  2468.                     end;
  2469.                 if Y<>YPos then
  2470.                     begin
  2471.                         YPos:=Y;
  2472.                         VScroll
  2473.                     end;
  2474.                 if TrackMode then
  2475.                     begin
  2476.                         wind_update(BEG_UPDATE);
  2477.                         with Window^ do WMRedraw(Work.X,Work.Y,Work.W,Work.H);
  2478.                         wind_update(END_UPDATE)
  2479.                     end
  2480.                 else
  2481.                     Window^.ForceRedraw
  2482.             end
  2483.     end;
  2484.  
  2485.  
  2486. procedure TScroller.SetPageSize;
  2487.  
  2488.     begin
  2489.         XPage:=Window^.Work.W div XUnit;
  2490.         YPage:=Window^.Work.H div YUnit
  2491.     end;
  2492.  
  2493.  
  2494. procedure TScroller.SetSBarRange;
  2495.     var dummy,pw,ph,xp,yp: longint;
  2496.         valid            : boolean;
  2497.  
  2498.     begin
  2499.         pw:=Window^.Work.W div XUnit;
  2500.         ph:=Window^.Work.H div YUnit;
  2501.         xp:=XPos;
  2502.         yp:=YPos;
  2503.         if xp+pw>=XRange then xp:=XRange-pw-1;
  2504.         if yp+ph>=YRange then yp:=YRange-ph-1;
  2505.         if xp<0 then xp:=0;
  2506.         if yp<0 then yp:=0;
  2507.         valid:=((xp<>XPos) or (yp<>YPos));
  2508.         XPos:=xp;
  2509.         YPos:=yp;
  2510.         if HasHScrollBar then
  2511.             begin
  2512.                 dummy:=(1000*(pw+1)) div XRange;
  2513.                 if dummy<1 then dummy:=1;
  2514.                 if dummy>1000 then dummy:=1000;
  2515.                 with Window^.Attr do
  2516.                     if gemHandle>=0 then
  2517.                         wind_set(gemHandle,WF_HSLSIZE,dummy,0,0,0)
  2518.             end;
  2519.         if HasVScrollBar then
  2520.             begin
  2521.                 dummy:=(1000*(ph+1)) div YRange;
  2522.                 if dummy<1 then dummy:=1;
  2523.                 if dummy>1000 then dummy:=1000;
  2524.                 with Window^.Attr do
  2525.                     if gemHandle>=0 then
  2526.                         wind_set(gemHandle,WF_VSLSIZE,dummy,0,0,0)
  2527.             end;
  2528.         HScroll;
  2529.         VScroll;
  2530.         if valid then Window^.ForceRedraw
  2531.     end;
  2532.  
  2533.  
  2534. procedure TScroller.SetRange(TheXRange,TheYRange: longint);
  2535.  
  2536.     begin
  2537.         XRange:=TheXRange;
  2538.         YRange:=TheYRange;
  2539.         if XRange<1 then XRange:=1;
  2540.         if YRange<1 then YRange:=1;
  2541.         SetSBarRange
  2542.     end;
  2543.  
  2544.  
  2545. procedure TScroller.SetUnits(TheXUnit,TheYUnit: integer);
  2546.  
  2547.     begin
  2548.         if TheXUnit<1 then TheXUnit:=1;
  2549.         if TheYUnit<1 then TheYUnit:=1;
  2550.         if (XUnit<>TheXUnit) or (YUnit<>TheYUnit) then
  2551.             begin
  2552.                 XUnit:=TheXUnit;
  2553.                 YUnit:=TheYUnit;
  2554.                 Window^.ForceRedraw
  2555.             end
  2556.     end;
  2557.  
  2558.  
  2559. function TScroller.GetXOrg: longint;
  2560.  
  2561.     begin
  2562.         GetXOrg:=Window^.Work.X-XPos*XUnit
  2563.     end;
  2564.  
  2565.  
  2566. function TScroller.GetYOrg: longint;
  2567.  
  2568.     begin
  2569.         GetYOrg:=Window^.Work.Y-YPos*YUnit
  2570.     end;
  2571.  
  2572. { *** TSCROLLER *** }
  2573.  
  2574.  
  2575.  
  2576. { *** Objekt TWINDOW *** }
  2577.  
  2578. constructor TWindow.Init(AParent: PWindow; ATitle: string);
  2579.     var p : PWindow;
  2580.         pp: ^PWindow;
  2581.  
  2582.   begin
  2583.       if not(inherited Init) then fail;
  2584.       Parent:=AParent;
  2585.     inc(Application^.HMax);
  2586.     with Attr do
  2587.         begin
  2588.           Title:=nil;
  2589.             SubTitle:=nil;
  2590.             Handle:=Application^.HMax;
  2591.             gemHandle:=-1;
  2592.             Style:=GetStyle;
  2593.             ExStyle:=ws_ex_Modeless;
  2594.                 fillchar(RBox,sizeof(RBox),0);
  2595.             Status:=ws_NoWindow
  2596.         end;
  2597.     vdiHandle:=Application^.vdiHandle;
  2598.     ChildList:=nil;
  2599.     Scroller:=nil;
  2600.     Prev:=nil;
  2601.     Nxt:=nil;
  2602.     if Parent<>nil then pp:=@Parent^.ChildList
  2603.     else
  2604.         pp:=@Application^.MainWindow;
  2605.         if pp^=nil then pp^:=@self
  2606.         else
  2607.             begin
  2608.                 p:=pp^;
  2609.                 while p^.Nxt<>nil do p:=p^.Nxt;
  2610.                 p^.Nxt:=@self;
  2611.                 Prev:=p
  2612.             end;
  2613.         DlgTree:=nil;
  2614.         tbtree:=-1;
  2615.         icntitl:=nil;
  2616.         icfpos:=-1;
  2617.     GetWindowClass(Class);
  2618.     EnableAutoCreate;
  2619.     SetTitle(ATitle);
  2620.     SetSubTitle('');
  2621.     Scroller:=GetScroller;
  2622.     SetupWindow
  2623.   end;
  2624.  
  2625.  
  2626. destructor TWindow.Done;
  2627.     var pp: ^PWindow;
  2628.  
  2629.     begin
  2630.         while (ChildList<>nil) do ChildList^.Free;
  2631.         ShutdownWindow;
  2632.         if Attr.Status in [ws_Created,ws_Open] then Destroy;
  2633.         FreeDialog;
  2634.         FreeToolbar;
  2635.         if Attr.Handle=Application^.HMax then dec(Application^.HMax);
  2636.     if Parent<>nil then pp:=@Parent^.ChildList
  2637.         else pp:=@Application^.MainWindow;
  2638.         if (Prev=nil) and (Nxt=nil) then pp^:=nil
  2639.         else
  2640.             begin
  2641.                 if Prev=nil then pp^:=Nxt
  2642.                     else Prev^.Nxt:=Nxt;
  2643.                 if Nxt<>nil then Nxt^.Prev:=Prev
  2644.             end;
  2645.         DisposeStr(Attr.Title);
  2646.         DisposeStr(Attr.SubTitle);
  2647.         DisposeStr(Class.lpszClassName);
  2648.         inherited Done
  2649.     end;
  2650.  
  2651.  
  2652. function TWindow.GetStyle: integer;
  2653.     var ret: integer;
  2654.  
  2655.     begin
  2656.         ret:=NAME or INFO or CLOSER or MOVER or FULLER or SIZER;
  2657.         if GEMVersion>=$0410 then
  2658.             begin
  2659.                 if TOSVersion=$0492 then ret:=ret or $1000
  2660.                 else
  2661.                     ret:=ret or SMALLER
  2662.             end;
  2663.         GetStyle:=ret
  2664.     end;
  2665.  
  2666.  
  2667. function TWindow.GetScroller: PScroller;
  2668.  
  2669.     begin
  2670.         GetScroller:=nil
  2671.     end;
  2672.  
  2673.  
  2674. procedure TWindow.GetWindowClass(var AWndClass: TWndClass);
  2675.  
  2676.     begin
  2677.         with AWndClass do
  2678.             begin
  2679.                 Style:=cs_DblClks or cs_CreateOnAccOpen or cs_AutoOpen;
  2680.                 hCursor:=ARROW;
  2681.                 hbrBackground:=White+1;
  2682.                 ToolbarTree:=nil;
  2683.                 MenuTree:=nil;
  2684.                 lpszClassName:=NewStr(GetClassName)
  2685.             end
  2686.     end;
  2687.  
  2688.  
  2689. function TWindow.GetClassName: string;
  2690.  
  2691.     begin
  2692.         GetClassName:='Window'
  2693.     end;
  2694.  
  2695.  
  2696. function TWindow.GetIconTitle: string;
  2697.  
  2698.     begin
  2699.         GetIconTitle:=Attr.Title^
  2700.     end;
  2701.  
  2702.  
  2703. function TWindow.CanClose: boolean;
  2704.     var valid: boolean;
  2705.             p    : PWindow;
  2706.  
  2707.     begin
  2708.         valid:=true;
  2709.       p:=ChildList;
  2710.       while (p<>nil) and valid do
  2711.           with p^ do
  2712.               begin
  2713.                   if Attr.Status=ws_Open then
  2714.                       if not(CanClose) then valid:=false;
  2715.                   p:=Nxt
  2716.               end;
  2717.         CanClose:=valid
  2718.     end;
  2719.  
  2720.  
  2721. function TWindow.IsIconified: boolean;
  2722.     var valid,dummy: integer;
  2723.  
  2724.     begin
  2725.         if (GEMVersion>=$0410) and (Attr.gemHandle>=0) then
  2726.             begin
  2727.                 wind_get(Attr.gemHandle,WF_ICONIFY,valid,dummy,dummy,dummy);
  2728.                 IsIconified:=(valid<>0)
  2729.             end
  2730.         else
  2731.             IsIconified:=(icfpos>=0)
  2732.     end;
  2733.  
  2734.  
  2735. function TWindow.IsModeless: boolean;
  2736.  
  2737.     begin
  2738.         IsModeless:=(Attr.gemHandle>=0)
  2739.     end;
  2740.  
  2741.  
  2742. function TWindow.IsDialog: boolean;
  2743.  
  2744.     begin
  2745.         IsDialog:=false
  2746.     end;
  2747.  
  2748.  
  2749. function TWindow.IsTop: boolean;
  2750.     var tw,dummy: integer;
  2751.  
  2752.     begin
  2753.         wind_get(DESK,WF_TOP,tw,dummy,dummy,dummy);
  2754.         IsTop:=((tw=Attr.gemHandle) and (Application^.DlgTop<0))
  2755.     end;
  2756.  
  2757.  
  2758. procedure TWindow.EnableAutoCreate;
  2759.  
  2760.     begin
  2761.         Class.Style:=Class.Style or cs_AutoCreate
  2762.     end;
  2763.  
  2764.  
  2765. procedure TWindow.DisableAutoCreate;
  2766.  
  2767.     begin
  2768.         Class.Style:=Class.Style and not(cs_AutoCreate)
  2769.     end;
  2770.  
  2771.  
  2772. procedure TWindow.GetFull;
  2773.     var r    : GRECT;
  2774.         mx,my: integer;
  2775.  
  2776.     begin
  2777.         if Attr.gemHandle<0 then exit;
  2778.         wind_get(Attr.gemHandle,WF_FULLXYWH,Full.X,Full.Y,Full.W,Full.H);
  2779.         GRtoA2(Full);
  2780.         Calc(WC_WORK,Full,r);
  2781.         GetWorkMax(mx,my);
  2782.         if (r.W>mx) or (r.H>my) then
  2783.             begin
  2784.                 if r.W>mx then r.W:=mx;
  2785.                 if r.H>my then r.H:=my;
  2786.                 Calc(WC_BORDER,r,Full);
  2787.                 Full.X:=Curr.X;
  2788.                 Full.Y:=Curr.Y;
  2789.                 if Full.X+Full.W-1>DRect.X2 then
  2790.                     begin
  2791.                         Full.X:=DRect.X2+1-Full.W;
  2792.                         if Full.X<DRect.X then Full.X:=DRect.X
  2793.                     end;
  2794.                 if Full.Y+Full.H-1>DRect.Y2 then
  2795.                     begin
  2796.                         Full.Y:=DRect.Y2+1-Full.H;
  2797.                         if Full.Y<DRect.Y then Full.Y:=DRect.Y
  2798.                     end;
  2799.                 GRtoA2(Full)
  2800.             end;
  2801.         ChkAlign(Full)
  2802.     end;
  2803.  
  2804.  
  2805. procedure TWindow.GetCurr;
  2806.  
  2807.     begin
  2808.         if Attr.gemHandle>=0 then
  2809.             begin
  2810.                 wind_get(Attr.gemHandle,WF_CURRXYWH,Curr.X,Curr.Y,Curr.W,Curr.H);
  2811.                 GRtoA2(Curr)
  2812.             end
  2813.     end;
  2814.  
  2815.  
  2816. procedure TWindow.GetWork;
  2817.  
  2818.     begin
  2819.         if Attr.gemHandle>=0 then
  2820.             begin
  2821.                 wind_get(Attr.gemHandle,WF_WORKXYWH,Work.X,Work.Y,Work.W,Work.H);
  2822.                 if Class.ToolbarTree<>nil then
  2823.                     if not(IsIconified) then
  2824.                         with Class.ToolbarTree^[ROOT] do
  2825.                             begin
  2826.                                 if ob_width>ob_height then
  2827.                                     begin
  2828.                                         if not(bTst(Class.Style,cs_ToolbarOpposite)) then inc(Work.Y,ob_height-1);
  2829.                                         dec(Work.H,ob_height-1)
  2830.                                     end
  2831.                                 else
  2832.                                     begin
  2833.                                         if not(bTst(Class.Style,cs_ToolbarOpposite)) then inc(Work.X,ob_width-1);
  2834.                                         dec(Work.W,ob_width-1)
  2835.                                     end
  2836.                             end;
  2837.                 GRtoA2(Work)
  2838.             end
  2839.     end;
  2840.  
  2841.  
  2842. procedure TWindow.SetCurr(r: GRECT);
  2843.  
  2844.     begin
  2845.         WMSized(r.X,r.Y,r.W,r.H)
  2846.     end;
  2847.  
  2848.  
  2849. procedure TWindow.SetWork(r: GRECT);
  2850.     var ro: GRECT;
  2851.  
  2852.     begin
  2853.         Calc(WC_BORDER,r,ro);
  2854.         WMSized(ro.X,ro.Y,ro.W,ro.H)
  2855.     end;
  2856.  
  2857.  
  2858. procedure TWindow.LoadToolbar(Indx: integer; Opposite: boolean);
  2859.     var tp: PTree;
  2860.  
  2861.     begin
  2862.         tp:=Application^.GetAddr(Indx);
  2863.         if (Class.ToolbarTree=nil) and (tp<>nil) then
  2864.             begin
  2865.                 Class.ToolbarTree:=tp;
  2866.                 tbtree:=Indx;
  2867.                 if Opposite then
  2868.                     Class.Style:=Class.Style or cs_ToolbarOpposite or cs_FullRedraw
  2869.                 else
  2870.                     Class.Style:=Class.Style and not(cs_ToolbarOpposite);
  2871.                 with Class.ToolbarTree^[ROOT] do
  2872.                     begin
  2873.                         if bTst(Application^.Attr.Style,as_3DFlags) then ob_flags:=ob_flags or FL3DBAK
  2874.                         else
  2875.                             ob_flags:=ob_flags and not(FL3DBAK);
  2876.                         if ob_height>ob_width then
  2877.                             begin
  2878.                                 tbsize:=ob_height;
  2879.                                 ob_height:=Application^.Attr.MaxPY
  2880.                              end
  2881.                         else
  2882.                             begin
  2883.                                 tbsize:=ob_width;
  2884.                                 ob_width:=Application^.Attr.MaxPX
  2885.                             end
  2886.                     end;
  2887.                 GetWork;
  2888.                 if Attr.Status=ws_Open then ForceRedraw
  2889.             end
  2890.         else
  2891.             Application^.Err:=em_InvalidToolbar
  2892.     end;
  2893.  
  2894.  
  2895. procedure TWindow.FreeToolbar;
  2896.  
  2897.     begin
  2898.         with Class do
  2899.             begin
  2900.                 if ToolbarTree<>nil then
  2901.                     begin
  2902.                         with ToolbarTree^[ROOT] do
  2903.                             begin
  2904.                                 if ob_height>ob_width then ob_height:=tbsize
  2905.                                 else
  2906.                                     ob_width:=tbsize
  2907.                             end
  2908.                     end;
  2909.                 ToolbarTree:=nil;
  2910.                 Style:=Style and not(cs_ToolbarOpposite)
  2911.             end;
  2912.         tbtree:=-1;
  2913.         GetWork;
  2914.         if Attr.Status=ws_Open then ForceRedraw
  2915.     end;
  2916.  
  2917.  
  2918. procedure TWindow.LoadDialog(Indx: integer);
  2919.     var tp: PTree;
  2920.  
  2921.     begin
  2922.         tp:=Application^.GetAddr(Indx);
  2923.         if (DlgTree=nil) and (tp<>nil) then
  2924.             begin
  2925.                 SetDlgTree(tp);
  2926.                 if Attr.Status=ws_Open then ForceRedraw
  2927.             end
  2928.         else
  2929.             Application^.Err:=em_InvalidDialog
  2930.     end;
  2931.  
  2932.  
  2933. procedure TWindow.FreeDialog;
  2934.  
  2935.     begin
  2936.         SetDlgTree(nil);
  2937.         if Attr.Status=ws_Open then ForceRedraw
  2938.     end;
  2939.  
  2940.  
  2941. procedure TWindow.SetDlgTree(tree: PTree);
  2942.  
  2943.     begin
  2944.         DlgTree:=tree
  2945.     end;
  2946.  
  2947.  
  2948. procedure TWindow.UpdateDialog;
  2949.  
  2950.     begin
  2951.         if DlgTree<>nil then
  2952.             with DlgTree^[ROOT] do
  2953.                 begin
  2954.                     if bTst(ob_state,OUTLINED) then
  2955.                         begin
  2956.                             ob_x:=Work.X+outlwidth;
  2957.                             ob_y:=Work.Y+outlwidth
  2958.                         end
  2959.                     else
  2960.                         begin
  2961.                             ob_x:=Work.X;
  2962.                             ob_y:=Work.Y
  2963.                         end
  2964.                 end
  2965.     end;
  2966.  
  2967.  
  2968. procedure TWindow.SetupSize;
  2969.  
  2970.     begin
  2971.         Full:=DRect;
  2972.         Curr:=Full;
  2973.         Calc(WC_WORK,Curr,Work)
  2974.     end;
  2975.  
  2976.  
  2977. procedure TWindow.SetupWindow;
  2978.     var pipe: Pipearray;
  2979.  
  2980.     begin
  2981.         SetupSize;
  2982.         pipe[0]:=WM_BOTTOMED;
  2983.         new(PKey,Init(@self,K_CTRL,Ctrl_Backdrop,@pipe,true));
  2984.         pipe[0]:=WM_CLOSED;
  2985.         new(PFUKey,Init(@self,K_CTRL,Ctrl_U,@pipe,true));
  2986.         pipe[0]:=WM_FULLED;
  2987.         new(PFUKey,Init(@self,K_CTRL,Ctrl_Fuller,@pipe,true));
  2988.         new(PWKey,Init(@self,-1,-1,nil,false));
  2989.         new(PIKey,Init(@self,K_CTRL,Ctrl_Iconify,nil,false));
  2990.         if AppFlag then 
  2991.             if bTst(Class.Style,cs_AutoOpen) then MakeWindow
  2992.     end;
  2993.  
  2994.  
  2995. procedure TWindow.ShutdownWindow;
  2996.  
  2997.     begin
  2998.     end;
  2999.  
  3000.  
  3001. procedure TWindow.MakeWindow;
  3002.  
  3003.     begin
  3004.         Create;
  3005.         OpenWindow
  3006.     end;
  3007.  
  3008.  
  3009. procedure TWindow.Create;
  3010.  
  3011.     begin
  3012.         if Attr.Status=ws_NoWindow then
  3013.             begin
  3014.               if Parent<>nil then
  3015.                   if Parent^.IsDialog then
  3016.                       if PDialog(Parent)^.IsModal then exit;
  3017.                 Attr.gemHandle:=wind_create(Attr.Style,Full.X,Full.Y,Full.W,Full.H);
  3018.                 if Attr.gemHandle<0 then Application^.Err:=em_InvalidWindow
  3019.                 else
  3020.                     begin
  3021.                         Attr.Status:=ws_Created;
  3022.                         if bTst(Attr.Style,NAME) then
  3023.                             wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@Attr.Title^[1])),integer(LoWord(@Attr.Title^[1])),0,0);
  3024.                         if bTst(Attr.Style,INFO) then
  3025.                             wind_set(Attr.gemHandle,WF_INFO,integer(HiWord(@Attr.SubTitle^[1])),integer(LoWord(@Attr.SubTitle^[1])),0,0);
  3026.                         if GEMVersion>=$0400 then
  3027.                             begin
  3028.                                 if bTst(Class.Style,cs_WorkBackground) then
  3029.                                     wind_set(Attr.gemHandle,WF_BEVENT,1,0,0,0)
  3030.                                 else
  3031.                                     wind_set(Attr.gemHandle,WF_BEVENT,0,0,0,0)
  3032.                             end;
  3033.                         CreateChildren
  3034.                     end
  3035.             end
  3036.         else
  3037.             CreateChildren
  3038.     end;
  3039.  
  3040.  
  3041. procedure TWindow.CreateChildren;
  3042.     var p: PWindow;
  3043.  
  3044.     begin
  3045.         p:=ChildList;
  3046.         while (p<>nil) do
  3047.             with p^ do
  3048.                 begin
  3049.                     if bTst(Class.Style,cs_AutoCreate) then Create;
  3050.                     p:=Nxt
  3051.                 end
  3052.     end;
  3053.  
  3054.  
  3055. procedure TWindow.OpenWindow;
  3056.     var p: PWindow;
  3057.  
  3058.     begin
  3059.         if Attr.Status=ws_Created then
  3060.             begin
  3061.                 wind_update(BEG_UPDATE);
  3062.                 ChkAlign(Curr);
  3063.                 ChkMin(Curr);
  3064.                 if bTst(Application^.Attr.Style,as_GrowShrink) then form_box(FMD_GROW,Curr);
  3065.                 if wind_open(Attr.gemHandle,Curr.X,Curr.Y,Curr.W,Curr.H)<>0 then
  3066.                     begin
  3067.                         Attr.Status:=ws_Open;
  3068.                         GetWork;
  3069.                         if Scroller<>nil then
  3070.                             with Scroller^ do
  3071.                                 begin
  3072.                                     SetPageSize;
  3073.                                     SetSBarRange
  3074.                                 end;
  3075.                         if bTst(Attr.ExStyle,ws_ex_Disabled) and (GEMVersion>=$0400) then
  3076.                             wind_set(Attr.gemHandle,WF_BOTTOM,0,0,0,0)
  3077.                         else
  3078.                             EnableCrsWatch;
  3079.                         p:=ChildList;
  3080.                         while (p<>nil) do
  3081.                             with p^ do
  3082.                                 begin
  3083.                                     OpenWindow;
  3084.                                     p:=Nxt
  3085.                                 end
  3086.                     end
  3087.                 else
  3088.                     Application^.Err:=em_WOpenFailure;
  3089.                 wind_update(END_UPDATE)
  3090.             end
  3091.         else
  3092.             if Attr.Status=ws_Open then
  3093.                 begin
  3094.                     if IsDialog then if PDialog(@self)^.IsModal then exit;
  3095.                     if not(bTst(Attr.ExStyle,ws_ex_Disabled)) then Top;
  3096.                     p:=ChildList;
  3097.                     while (p<>nil) do
  3098.                         with p^ do
  3099.                             begin
  3100.                                 OpenWindow;
  3101.                                 p:=Nxt
  3102.                             end
  3103.                 end
  3104.     end;
  3105.  
  3106.  
  3107. procedure TWindow.CloseWindow;
  3108.     var p         : PWindow;
  3109.             ICFFreePos: procedure(d1,d2: pointer; d3,d4,d5: longint; fn,posnr: integer);
  3110.  
  3111.     begin
  3112.         p:=ChildList;
  3113.         while (p<>nil) do
  3114.             with p^ do
  3115.                 begin
  3116.                     CloseWindow;
  3117.                     p:=Nxt
  3118.                 end;
  3119.         if Attr.Status=ws_Open then
  3120.             begin
  3121.                 wind_update(BEG_UPDATE);
  3122.                 GetCurr;
  3123.                 if bTst(Application^.Attr.Style,as_GrowShrink) then form_box(FMD_SHRINK,Curr);
  3124.                 if wind_close(Attr.gemHandle)<>0 then Attr.Status:=ws_Created
  3125.                 else
  3126.                     Application^.Err:=em_WCloseFailure;
  3127.                 if icfpos>=0 then
  3128.                     begin
  3129.                         Curr:=icfcurr;
  3130.                         SetGadgets(icfstyle);
  3131.                         ICFFreePos:=icfserver;
  3132.                         ICFFreePos(nil,nil,0,0,0,ICF_FREEPOS,icfpos);
  3133.                         icfpos:=-1
  3134.                     end;
  3135.                 DisableCrsWatch;
  3136.                 wind_update(END_UPDATE)
  3137.             end
  3138.     end;
  3139.  
  3140.  
  3141. procedure TWindow.Destroy;
  3142.     var p: PWindow;
  3143.  
  3144.     begin
  3145.         p:=ChildList;
  3146.         while (p<>nil) do
  3147.             with p^ do
  3148.                 begin
  3149.                     Destroy;
  3150.                     p:=Nxt
  3151.                 end;
  3152.         if Attr.Status in [ws_Created,ws_Open] then
  3153.             begin
  3154.                 CloseWindow;
  3155.                 if Attr.Status=ws_Created then
  3156.                     begin
  3157.                         if wind_delete(Attr.gemHandle)<>0 then
  3158.                             with Attr do
  3159.                                 begin
  3160.                                     Status:=ws_NoWindow;
  3161.                                     gemHandle:=-1
  3162.                                 end
  3163.                         else
  3164.                             Application^.Err:=em_WDestroyFailure
  3165.                     end
  3166.             end
  3167.     end;
  3168.  
  3169.  
  3170. procedure TWindow.RawDestroy;
  3171.     var p: PWindow;
  3172.             ICFFreePos: procedure(d1,d2: pointer; d3,d4,d5: longint; fn,posnr: integer);
  3173.  
  3174.     begin
  3175.         p:=ChildList;
  3176.         while (p<>nil) do
  3177.             with p^ do
  3178.                 begin
  3179.                     RawDestroy;
  3180.                     p:=Nxt
  3181.                 end;
  3182.         with Attr do
  3183.             begin
  3184.                 DisableCrsWatch;
  3185.                 Status:=ws_NoWindow;
  3186.                 gemHandle:=-1
  3187.             end;
  3188.         if icfpos>=0 then
  3189.             begin
  3190.                 Curr:=icfcurr;
  3191.                 Attr.Style:=icfstyle;
  3192.                 ICFFreePos:=icfserver;
  3193.                 ICFFreePos(nil,nil,0,0,0,ICF_FREEPOS,icfpos);
  3194.                 icfpos:=-1
  3195.             end
  3196.     end;
  3197.  
  3198.  
  3199. procedure TWindow.Top;
  3200.     var it: boolean;
  3201.  
  3202.     begin
  3203.         if Attr.Status=ws_Open then
  3204.             begin
  3205.                 wind_update(BEG_UPDATE);
  3206.                 it:=IsTop;
  3207.                 wind_set(Attr.gemHandle,WF_TOP,0,0,0,0);
  3208.                 if bTst(Class.Style,cs_FullRedraw) then
  3209.                     if not(it) then ForceRedraw;
  3210.                 EnableCrsWatch;
  3211.                 wind_update(END_UPDATE)
  3212.             end
  3213.     end;
  3214.  
  3215.  
  3216. procedure TWindow.FullSize;
  3217.     var r: GRECT;
  3218.  
  3219.     begin
  3220.         if Attr.Status=ws_Open then
  3221.             begin
  3222.                 wind_update(BEG_UPDATE);
  3223.                 GetFull;
  3224.                 wind_get(Attr.gemHandle,WF_CURRXYWH,r.X,r.Y,r.W,r.H);
  3225.                 if (Full.X=r.X) and (Full.Y=r.Y) and (Full.W=r.W) and (Full.H=r.H) then
  3226.                     begin
  3227.                         if bTst(Application^.Attr.Style,as_GrowShrink) then
  3228.                             form_dial(FMD_SHRINK,Curr.X,Curr.Y,Curr.W,Curr.H,Full.X,Full.Y,Full.W,Full.H);
  3229.                         r:=Curr
  3230.                     end
  3231.                 else
  3232.                     begin
  3233.                         if bTst(Application^.Attr.Style,as_GrowShrink) then
  3234.                             form_dial(FMD_GROW,Curr.X,Curr.Y,Curr.W,Curr.H,Full.X,Full.Y,Full.W,Full.H);
  3235.                         r:=Full
  3236.                     end;
  3237.                 wind_set(Attr.gemHandle,WF_CURRXYWH,r.X,r.Y,r.W,r.H);
  3238.                 GetWork;
  3239.                 UpdateDialog;
  3240.                 if bTst(Class.Style,cs_FullRedraw) then ForceRedraw;
  3241.                 wind_update(END_UPDATE)
  3242.             end
  3243.     end;
  3244.  
  3245.  
  3246. procedure TWindow.Size(r: GRECT);
  3247.  
  3248.     begin
  3249.         if Attr.Status=ws_Open then
  3250.             begin
  3251.                 wind_update(BEG_UPDATE);
  3252.                 Curr:=r;
  3253.                 wind_set(Attr.gemHandle,WF_CURRXYWH,r.X,r.Y,r.W,r.H);
  3254.                 GetWork;
  3255.                 UpdateDialog;
  3256.                 if bTst(Class.Style,cs_FullRedraw) then ForceRedraw;
  3257.                 wind_update(END_UPDATE)
  3258.             end
  3259.         else
  3260.             Curr:=r
  3261.     end;
  3262.  
  3263.  
  3264. procedure TWindow.Move(r: GRECT);
  3265.     var chg: boolean;
  3266.  
  3267.     begin
  3268.         if Attr.Status=ws_Open then
  3269.             begin
  3270.                 wind_update(BEG_UPDATE);
  3271.                 chg:=((Curr.X<>r.X) or (Curr.Y<>r.Y));
  3272.                 Curr:=r;
  3273.                 wind_set(Attr.gemHandle,WF_CURRXYWH,r.X,r.Y,r.W,r.H);
  3274.                 GetWork;
  3275.                 UpdateDialog;
  3276.                 if bTst(Class.Style,cs_FullRedraw) and chg then ForceRedraw;
  3277.                 wind_update(END_UPDATE)
  3278.             end
  3279.         else
  3280.             Curr:=r
  3281.     end;
  3282.  
  3283.  
  3284. procedure TWindow.InitPaint;
  3285.  
  3286.     begin
  3287.     end;
  3288.  
  3289.  
  3290. procedure TWindow.Paint(var PaintInfo: TPaintStruct);
  3291.  
  3292.     begin
  3293.         if DlgTree<>nil then
  3294.             with PaintInfo.rcPaint do objc_draw(DlgTree,ROOT,MAX_DEPTH,X,Y,W,H)
  3295.     end;
  3296.  
  3297.  
  3298. procedure TWindow.IconPaint(var PaintInfo: TPaintStruct);
  3299.  
  3300.     begin
  3301.     end;
  3302.  
  3303.  
  3304. procedure TWindow.ExitPaint;
  3305.  
  3306.     begin
  3307.     end;
  3308.  
  3309.  
  3310. procedure TWindow.ForceRedraw;
  3311.     var pipe: Pipearray;
  3312.         r   : GRECT;
  3313.  
  3314.     begin
  3315.         if Attr.Status=ws_Open then
  3316.             begin
  3317.                 wind_update(BEG_UPDATE);
  3318.                 GetWork;
  3319.                 if bTst(Class.Style,cs_ToolbarOpposite) then
  3320.                     wind_get(Attr.gemHandle,WF_WORKXYWH,r.X,r.Y,r.W,r.H)
  3321.                 else
  3322.                     r:=Work;
  3323.                 pipe[0]:=WM_REDRAW;
  3324.                 pipe[1]:=Application^.apID;
  3325.                 pipe[2]:=0;
  3326.                 pipe[3]:=Attr.gemHandle;
  3327.                 pipe[4]:=r.X;
  3328.                 pipe[5]:=r.Y;
  3329.                 pipe[6]:=r.W;
  3330.                 pipe[7]:=r.H;
  3331.                 appl_write(pipe[1],16,@pipe);
  3332.                 wind_update(END_UPDATE)
  3333.             end
  3334.     end;
  3335.  
  3336.  
  3337. procedure TWindow.SetTitle(ATitle: string);
  3338.  
  3339.     begin
  3340.         DisposeStr(Attr.Title);
  3341.         ATitle:=StrPLeft(StrPTrimF(ATitle),78);
  3342.         if length(Atitle)>0 then ATitle:=' '+ATitle+' ';
  3343.         ATitle:=ATitle+#0;
  3344.         Attr.Title:=NewStr(ATitle);
  3345.       if (Attr.Status in [ws_Created,ws_Open]) then
  3346.           if not(IsIconified) then
  3347.               if bTst(Attr.Style,NAME) then
  3348.                     wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@Attr.Title^[1])),integer(LoWord(@Attr.Title^[1])),0,0)
  3349.     end;
  3350.  
  3351.  
  3352. procedure TWindow.SetSubTitle(AnInfo: string);
  3353.  
  3354.     begin
  3355.         DisposeStr(Attr.SubTitle);
  3356.         AnInfo:=StrPLeft(AnInfo,80)+#0;
  3357.         if length(AnInfo)=1 then AnInfo:=' '+AnInfo;
  3358.         Attr.SubTitle:=NewStr(AnInfo);
  3359.       if (Attr.Status in [ws_Created,ws_Open]) then
  3360.           if bTst(Attr.Style,INFO) then
  3361.                 wind_set(Attr.gemHandle,WF_INFO,integer(HiWord(@Attr.SubTitle^[1])),integer(LoWord(@Attr.SubTitle^[1])),0,0)
  3362.     end;
  3363.  
  3364.  
  3365. procedure TWindow.SetGadgets(Style: integer);
  3366.     label _error,_open;
  3367.  
  3368.     var wasopen: boolean;
  3369.  
  3370.     begin
  3371.         if Attr.Status=ws_NoWindow then exit;
  3372.         if Style<>Attr.Style then
  3373.             begin
  3374.                 wind_update(BEG_UPDATE);
  3375.                 DisableCrsWatch;
  3376.                 GetCurr;
  3377.                 wasopen:=(Attr.Status=ws_Open);
  3378.                 if wasopen then
  3379.                     if wind_close(Attr.gemHandle)=0 then goto _error;
  3380.                 Attr.Status:=ws_Created;
  3381.                 if wind_delete(Attr.gemHandle)=0 then goto _open;
  3382.                 Attr.Style:=Style;
  3383.                 Attr.gemHandle:=wind_create(Attr.Style,Full.X,Full.Y,Full.W,Full.H);
  3384.                 if Attr.gemHandle<0 then
  3385.                     begin
  3386.                         Attr.Status:=ws_NoWindow;
  3387.                         Application^.Err:=em_InvalidWindow;
  3388.                         goto _error
  3389.                     end;
  3390.                 if bTst(Attr.Style,NAME) then
  3391.                     wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@Attr.Title^[1])),integer(LoWord(@Attr.Title^[1])),0,0);
  3392.                 if bTst(Attr.Style,INFO) then
  3393.                     wind_set(Attr.gemHandle,WF_INFO,integer(HiWord(@Attr.SubTitle^[1])),integer(LoWord(@Attr.SubTitle^[1])),0,0);
  3394.                 if GEMVersion>=$0400 then
  3395.                     begin
  3396.                         if bTst(Class.Style,cs_WorkBackground) then
  3397.                             wind_set(Attr.gemHandle,WF_BEVENT,1,0,0,0)
  3398.                         else
  3399.                             wind_set(Attr.gemHandle,WF_BEVENT,0,0,0,0)
  3400.                     end;
  3401.                 _open:
  3402.                 if wasopen then
  3403.                     begin
  3404.                         if wind_open(Attr.gemHandle,Curr.X,Curr.Y,Curr.W,Curr.H)<>0 then
  3405.                             begin
  3406.                                 Attr.Status:=ws_Open;
  3407.                                 GetWork;
  3408.                                 if Scroller<>nil then
  3409.                                     with Scroller^ do
  3410.                                         begin
  3411.                                             SetPageSize;
  3412.                                             SetSBarRange
  3413.                                         end;
  3414.                                 if bTst(Attr.ExStyle,ws_ex_Disabled) and (GEMVersion>=$0400) then
  3415.                                     wind_set(Attr.gemHandle,WF_BOTTOM,0,0,0,0)
  3416.                                 else
  3417.                                     EnableCrsWatch
  3418.                             end
  3419.                         else
  3420.                             Application^.Err:=em_WOpenFailure
  3421.                     end;
  3422.                 _error:
  3423.                 wind_update(END_UPDATE)
  3424.             end
  3425.     end;
  3426.  
  3427.  
  3428. procedure TWindow.SetCursor(Crs: HCursor);
  3429.     var cr       : GRECT;
  3430.         x,y,dummy: integer;
  3431.  
  3432.     begin
  3433.         wind_update(BEG_UPDATE);
  3434.         Class.hCursor:=Crs;
  3435.         if Application^.pcrswatch=@self then
  3436.             if Crs>id_No then
  3437.                 if not(IsMouseBusy) then
  3438.                     begin
  3439.                         graf_mkstate(x,y,dummy,dummy);
  3440.                         Application^.GetCrsRect(cr);
  3441.                         if Between(x,cr.X1,cr.X2) and Between(y,cr.Y1,cr.Y2) then
  3442.                             begin
  3443.                                 if Crs>$7fff then graf_mouse(USER_DEF,pointer(Crs))
  3444.                                 else
  3445.                                     graf_mouse(Crs,nil)
  3446.                             end
  3447.                     end;
  3448.         wind_update(END_UPDATE)
  3449.     end;
  3450.  
  3451.  
  3452. procedure TWindow.Calc(ctype: integer; ri: GRECT; var ro: GRECT);
  3453.  
  3454.     begin
  3455.         if ctype=WC_BORDER then
  3456.             if Class.ToolbarTree<>nil then
  3457.                 if not(IsIconified) then
  3458.                     with Class.ToolbarTree^[ROOT] do
  3459.                         begin
  3460.                             if ob_width>ob_height then
  3461.                                 begin
  3462.                                     if not(bTst(Class.Style,cs_ToolbarOpposite)) then dec(ri.Y,ob_height-1);
  3463.                                     inc(ri.H,ob_height-1)
  3464.                                 end
  3465.                             else
  3466.                                 begin
  3467.                                     if not(bTst(Class.Style,cs_ToolbarOpposite)) then dec(ri.X,ob_width-1);
  3468.                                     inc(ri.W,ob_width-1)
  3469.                                 end
  3470.                         end;
  3471.         wind_calc(ctype,Attr.Style,ri.X,ri.Y,ri.W,ri.H,ro.X,ro.Y,ro.W,ro.H);
  3472.         if ctype=WC_WORK then
  3473.             if Class.ToolbarTree<>nil then
  3474.                 if not(IsIconified) then
  3475.                     with Class.ToolbarTree^[ROOT] do
  3476.                         begin
  3477.                             if ob_width>ob_height then
  3478.                                 begin
  3479.                                     if not(bTst(Class.Style,cs_ToolbarOpposite)) then inc(ro.Y,ob_height-1);
  3480.                                     dec(ro.H,ob_height-1)
  3481.                                 end
  3482.                             else
  3483.                                 begin
  3484.                                     if not(bTst(Class.Style,cs_ToolbarOpposite)) then inc(ro.X,ob_width-1);
  3485.                                     dec(ro.W,ob_width-1)
  3486.                                 end
  3487.                         end;
  3488.         GRtoA2(ro)
  3489.     end;
  3490.  
  3491.  
  3492. procedure TWindow.ChkAlign(var r: GRECT);
  3493.     var ro: GRECT;
  3494.  
  3495.     begin
  3496.         if r.X<DRect.X then r.X:=DRect.X;
  3497.         if r.Y<DRect.Y then r.Y:=DRect.Y;
  3498.         if bTst(Class.Style,cs_ByteAlignClient) then
  3499.             begin
  3500.                 Calc(WC_WORK,r,ro);
  3501.                 ro.X:=(ro.X shr 3) shl 3;
  3502.                 Calc(WC_BORDER,ro,r);
  3503.                 if r.X<DRect.X then
  3504.                     begin
  3505.                         while r.X<DRect.X do inc(r.X,8);
  3506.                         ChkMax(r)
  3507.                     end
  3508.             end
  3509.         else
  3510.             if bTst(Class.Style,cs_ByteAlignWindow) then
  3511.                 begin
  3512.                     r.X:=(r.X shr 3) shl 3;
  3513.                     if r.X<DRect.X then
  3514.                         begin
  3515.                             while r.X<DRect.X do inc(r.X,8);
  3516.                             ChkMax(r)
  3517.                         end
  3518.                 end;
  3519.         if bTst(Class.Style,cs_VerAlignClient) then
  3520.             begin
  3521.                 Calc(WC_WORK,r,ro);
  3522.                 ro.Y:=(ro.Y shr 1) shl 1;
  3523.                 Calc(WC_BORDER,ro,r);
  3524.                 if r.Y<DRect.Y then
  3525.                     begin
  3526.                         while r.Y<DRect.Y do inc(r.Y,2);
  3527.                         ChkMax(r)
  3528.                     end
  3529.             end
  3530.         else
  3531.             if bTst(Class.Style,cs_VerAlignWindow) then
  3532.                 begin
  3533.                     r.Y:=(r.Y shr 1) shl 1;
  3534.                     if r.Y<DRect.Y then
  3535.                         begin
  3536.                             while r.Y<DRect.Y do inc(r.Y,2);
  3537.                             ChkMax(r)
  3538.                         end
  3539.                 end;
  3540.         GRtoA2(r)
  3541.      end;
  3542.  
  3543.  
  3544. procedure TWindow.ChkMin(var r: GRECT);
  3545.     var ro             : GRECT;
  3546.         mix,miy,mxx,mxy: integer;
  3547.  
  3548.     begin
  3549.         Calc(WC_WORK,r,ro);
  3550.         GetWorkMin(mix,miy);
  3551.         GetWorkMax(mxx,mxy);
  3552.         if (ro.W>mxx) or (ro.H>mxy) then
  3553.             begin
  3554.                 if ro.W>mxx then ro.W:=mxx;
  3555.                 if ro.H>mxy then ro.H:=mxy;
  3556.                 Calc(WC_BORDER,ro,r)
  3557.             end;
  3558.         if (ro.W<mix) or (ro.H<miy) then
  3559.             begin
  3560.                 if ro.W<mix then ro.W:=mix;
  3561.                 if ro.H<miy then ro.H:=miy;
  3562.                 Calc(WC_BORDER,ro,r)
  3563.             end;
  3564.         GRtoA2(r)
  3565.     end;
  3566.  
  3567.  
  3568. procedure TWindow.ChkMax(var r: GRECT);
  3569.  
  3570.     begin
  3571.         if r.X+r.W-1>DRect.X2 then r.X:=DRect.X2+1-r.W;
  3572.         if r.Y+r.H-1>DRect.Y2 then r.Y:=DRect.Y2+1-r.H;
  3573.         GRtoA2(r)
  3574.     end;
  3575.  
  3576.  
  3577. procedure TWindow.GetWorkMin(var minX,minY: integer);
  3578.  
  3579.     begin
  3580.         minX:=21;
  3581.         minY:=1
  3582.     end;
  3583.  
  3584.  
  3585. procedure TWindow.GetWorkMax(var maxX,maxY: integer);
  3586.  
  3587.     begin
  3588.         maxX:=maxint;
  3589.         maxY:=maxint
  3590.     end;
  3591.  
  3592.  
  3593. function TWindow.GetDC: integer;
  3594.     var box: GRECT;
  3595.  
  3596.     begin
  3597.         GetDC:=-1;
  3598.         wind_update(BEG_UPDATE);
  3599.         if FirstWorkRect(box) then
  3600.             begin
  3601.                 HideMouse;
  3602.                 vs_clip(vdiHandle,CLIP_ON,box.A2);
  3603.                 GetDC:=vdiHandle
  3604.             end
  3605.         else
  3606.             wind_update(END_UPDATE)
  3607.     end;
  3608.  
  3609.  
  3610. procedure TWindow.ReleaseDC;
  3611.  
  3612.     begin
  3613.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  3614.         ShowMouse;
  3615.         wind_update(END_UPDATE)
  3616.     end;
  3617.  
  3618.  
  3619. procedure TWindow.WMRedraw(X,Y,W,H: integer);
  3620.     var box,area   : GRECT;
  3621.         PaintInfo  : TPaintStruct;
  3622.         icn,visible: boolean;
  3623.  
  3624.     begin
  3625.         if Attr.Status<>ws_Open then exit;
  3626.         area.X:=X;
  3627.         area.Y:=Y;
  3628.         area.W:=W;
  3629.         area.H:=H;
  3630.         HideMouse;
  3631.         icn:=IsIconified;
  3632.         if Class.ToolbarTree<>nil then
  3633.             if not(icn) then
  3634.                 begin
  3635.                     wind_get(Attr.gemHandle,WF_WORKXYWH,box.X,box.Y,box.W,box.H);
  3636.                     with Class.ToolbarTree^[ROOT] do
  3637.                         if bTst(Class.Style,cs_ToolbarOpposite) then
  3638.                             begin
  3639.                                 if ob_width>ob_height then
  3640.                                     begin
  3641.                                         ob_x:=box.X-1;
  3642.                                         ob_y:=box.Y+box.H+1-ob_height
  3643.                                     end
  3644.                                 else
  3645.                                     begin
  3646.                                         ob_x:=box.X+box.W+1-ob_width;
  3647.                                         ob_y:=box.Y-1
  3648.                                     end
  3649.                             end
  3650.                         else
  3651.                             begin
  3652.                                 ob_x:=box.X-1;
  3653.                                 ob_y:=box.Y-1
  3654.                             end;
  3655.                     wind_get(Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  3656.                     while (box.W>0) and (box.H>0) do
  3657.                         begin
  3658.                             if rc_intersect(DRect,box) then
  3659.                                 if rc_intersect(area,box) then
  3660.                                     with box do objc_draw(Class.ToolbarTree,ROOT,MAX_DEPTH,X,Y,W,H);
  3661.                             wind_get(Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  3662.                         end
  3663.                 end;
  3664.         visible:=FirstWorkRect(box);
  3665.         UpdateDialog;
  3666.         InitPaint;
  3667.         while visible do
  3668.             begin
  3669.                 if rc_intersect(area,box) then
  3670.                     begin
  3671.                         vs_clip(vdiHandle,CLIP_ON,box.A2);
  3672.                         with PaintInfo do
  3673.                             begin
  3674.                                 rcPaint:=box;
  3675.                                 feColor:=Class.hbrBackground-1;
  3676.                                 if feColor>=0 then
  3677.                                     begin
  3678.                                         fErase:=true;
  3679.                                         gem.vswr_mode(vdiHandle,MD_REPLACE);
  3680.                                         gem.vsf_interior(vdiHandle,FIS_SOLID);
  3681.                                         gem.vsf_color(vdiHandle,feColor);
  3682.                                         vr_recfl(vdiHandle,rcPaint.A2);
  3683.                                         gem.vswr_mode(vdiHandle,GP.wrmode);
  3684.                                         gem.vsf_interior(vdiHandle,GP.finterior);
  3685.                                         gem.vsf_color(vdiHandle,GP.fcolor)
  3686.                                     end
  3687.                                 else
  3688.                                     fErase:=false
  3689.                             end;
  3690.                         if icn then IconPaint(PaintInfo)
  3691.                         else
  3692.                             Paint(PaintInfo)
  3693.                     end;
  3694.                 visible:=NextWorkRect(box)
  3695.             end;
  3696.         ExitPaint;
  3697.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  3698.         ShowMouse
  3699.     end;
  3700.  
  3701.  
  3702. procedure TWindow.WMTopped;
  3703.  
  3704.     begin
  3705.         Top
  3706.     end;
  3707.  
  3708.  
  3709. procedure TWindow.WMClosed;
  3710.  
  3711.     begin
  3712.         if CanClose then
  3713.             begin
  3714.                 Application^.ChkError;
  3715.                 Destroy;
  3716.                 with Application^ do if ChkError>=em_OutOfMemory then Quit
  3717.             end
  3718.     end;
  3719.  
  3720.  
  3721. procedure TWindow.WMFulled;
  3722.  
  3723.     begin
  3724.         FullSize;
  3725.         if Scroller<>nil then
  3726.             with Scroller^ do
  3727.                 begin
  3728.                     SetPageSize;
  3729.                     SetSBarRange
  3730.                 end
  3731.     end;
  3732.  
  3733.  
  3734. procedure TWindow.WMArrowed(wA: integer);
  3735.  
  3736.     begin
  3737.         case wa of
  3738.             WA_UPPAGE: WAUpPage;
  3739.             WA_DNPAGE: WADnPage;
  3740.             WA_UPLINE: WAUpLine;
  3741.             WA_DNLINE: WADnLine;
  3742.             WA_LFPAGE: WALfPage;
  3743.             WA_RTPAGE: WARtPage;
  3744.             WA_LFLINE: WALfLine;
  3745.             WA_RTLINE: WARtLine
  3746.         end
  3747.     end;
  3748.  
  3749.  
  3750. procedure TWindow.WMHSlid(Value: integer);
  3751.     var dif: longint;
  3752.  
  3753.     begin
  3754.         if Scroller<>nil then
  3755.             with Scroller^ do
  3756.                 begin
  3757.                     dif:=XRange-XPage-1;
  3758.                     if dif<1 then dif:=1;
  3759.                     ScrollTo((Value*dif) div 1000,YPos)
  3760.                 end
  3761.     end;
  3762.  
  3763.  
  3764. procedure TWindow.WMVSlid(Value: integer);
  3765.     var dif: longint;
  3766.  
  3767.     begin
  3768.         if Scroller<>nil then
  3769.             with Scroller^ do
  3770.                 begin
  3771.                     dif:=YRange-YPage-1;
  3772.                     if dif<1 then dif:=1;
  3773.                     ScrollTo(XPos,(Value*dif) div 1000)
  3774.                 end
  3775.     end;
  3776.  
  3777.  
  3778. procedure TWindow.WMSized(X,Y,W,H: integer);
  3779.     var r: GRECT;
  3780.  
  3781.     begin
  3782.         r.X:=X;
  3783.         r.Y:=Y;
  3784.         r.W:=W;
  3785.         r.H:=H;
  3786.         ChkAlign(r);
  3787.         ChkMin(r);
  3788.         Size(r);
  3789.         if Scroller<>nil then
  3790.             with Scroller^ do
  3791.                 begin
  3792.                     SetPageSize;
  3793.                     SetSBarRange
  3794.                 end
  3795.     end;
  3796.  
  3797.  
  3798. procedure TWindow.WMMoved(X,Y,W,H: integer);
  3799.     var r: GRECT;
  3800.  
  3801.     begin
  3802.         r.X:=X;
  3803.         r.Y:=Y;
  3804.         r.W:=W;
  3805.         r.H:=H;
  3806.         ChkAlign(r);
  3807.         ChkMin(r);
  3808.         Move(r);
  3809.         if Scroller<>nil then
  3810.             with Scroller^ do
  3811.                 begin
  3812.                     SetPageSize;
  3813.                     SetSBarRange
  3814.                 end
  3815.     end;
  3816.  
  3817.  
  3818. procedure TWindow.WMButton(mX,mY,BStat,KStat,Clicks: integer);
  3819.     var r    : GRECT;
  3820.         valid: boolean;
  3821.  
  3822.     begin
  3823.         if BStat=1 then
  3824.             begin
  3825.                 if Clicks=1 then
  3826.                     begin
  3827.                         valid:=true;
  3828.                         if bTst(Class.Style,cs_Rubbox) then
  3829.                             begin
  3830.                                 r.X:=Work.X+Attr.RBox.X1;
  3831.                                 r.Y:=Work.Y+Attr.RBox.Y1;
  3832.                                 r.W:=Work.W-Attr.RBox.X2;
  3833.                                 r.H:=Work.H-Attr.RBox.Y2;
  3834.                                 if (r.W>0) and (r.H>0) then
  3835.                                     if rc_intersect(Work,r) then
  3836.                                         if (mX>=r.X1) and (mX<=r.X2) and (mY>=r.Y1) and (mY<=r.Y2) then
  3837.                                             begin
  3838.                                                 valid:=false;
  3839.                                                 if Application^.Rubbox(Attr.gemHandle,mX,mY,r.X1,r.Y1,r.X2,r.Y2,r) then WMRubbox(r)
  3840.                                             end
  3841.                             end;
  3842.                         if valid then WMClick(mX,mY,KStat)
  3843.                     end
  3844.                 else
  3845.                     if Clicks=2 then
  3846.                         if bTst(Class.Style,cs_DblClks) then WMDblClick(mX,mY,KStat)
  3847.             end
  3848.         else
  3849.             if BStat=2 then WMRButton(mX,mY,KStat,Clicks)
  3850.     end;
  3851.  
  3852.  
  3853. procedure TWindow.WMClick(mX,mY,KStat: integer);
  3854.  
  3855.     begin
  3856.     end;
  3857.  
  3858.  
  3859. procedure TWindow.WMDblClick(mX,mY,KStat: integer);
  3860.  
  3861.     begin
  3862.     end;
  3863.  
  3864.  
  3865. procedure TWindow.WMRButton(mX,mY,KStat,Clicks: integer);
  3866.  
  3867.     begin
  3868.     end;
  3869.  
  3870.  
  3871. procedure TWindow.WMRubbox(r: GRECT);
  3872.  
  3873.     begin
  3874.     end;
  3875.  
  3876.  
  3877. procedure TWindow.WMRBoxChanged(r: GRECT);
  3878.  
  3879.     begin
  3880.     end;
  3881.  
  3882.  
  3883. procedure TWindow.WMRBoxCheck(x,y,xmin,ymin,xmax,ymax: integer; var mx,my: integer);
  3884.  
  3885.     begin
  3886.     end;
  3887.  
  3888.  
  3889. procedure TWindow.WMNewTop;
  3890.  
  3891.     begin
  3892.         WMUntopped
  3893.     end;
  3894.  
  3895.  
  3896. procedure TWindow.WMUntopped;
  3897.  
  3898.     begin
  3899.         DisableCrsWatch
  3900.     end;
  3901.  
  3902.  
  3903. procedure TWindow.WMOnTop;
  3904.  
  3905.     begin
  3906.         WMTopped
  3907.     end;
  3908.  
  3909.  
  3910. procedure TWindow.WMBottomed;
  3911.  
  3912.     begin
  3913.         if Attr.Status=ws_Open then
  3914.             if GEMVersion>=$0400 then
  3915.                 begin
  3916.                     wind_set(Attr.gemHandle,WF_BOTTOM,0,0,0,0);
  3917.                     DisableCrsWatch
  3918.                 end
  3919.     end;
  3920.  
  3921.  
  3922. procedure TWindow.WMToolbar(Indx,BStat,KStat,Clicks: integer);
  3923.     var p             : PEvent;
  3924.         pipe          : Pipearray;
  3925.         dummy,bx,by,bs: integer;
  3926.         brect,mrect   : GRECT;
  3927.         onbtn,inrect  : boolean;
  3928.  
  3929.     begin
  3930.         if Class.ToolbarTree=nil then exit;
  3931.         if Attr.Status<>ws_Open then exit;
  3932.         pipe[0]:=GO_PRIVATE;
  3933.         pipe[1]:=Application^.apID;
  3934.         pipe[2]:=0;
  3935.         pipe[3]:=GOP_TOOLBAR;
  3936.         pipe[4]:=tbtree;
  3937.         pipe[5]:=Indx;
  3938.         pipe[6]:=KStat;
  3939.         pipe[7]:=Clicks;
  3940.         p:=EventList;
  3941.         while p<>nil do
  3942.             if p^.TestMessage(pipe) then
  3943.                 with PToolbar(p)^ do
  3944.                     begin
  3945.                         if BStat<>2 then
  3946.                             begin
  3947.                                 if GetState=bf_Disabled then exit;
  3948.                                 if not(bTst(ObjAddr^.ob_flags,SELECTABLE)) then
  3949.                                     begin
  3950.                                         Work;
  3951.                                         if VPipe<>nil then
  3952.                                             begin
  3953.                                                 if VGHnd then VPipe^[3]:=Attr.gemHandle;
  3954.                                                 appl_write(Application^.apID,16,VPipe)
  3955.                                             end;
  3956.                                         exit
  3957.                                     end;
  3958.                                 wind_update(BEG_UPDATE);
  3959.                                 wind_update(BEG_MCTRL);
  3960.                                 onbtn:=true;
  3961.                                 if IsSwitch then
  3962.                                     begin
  3963.                                         Toggle;
  3964.                                         repeat
  3965.                                             graf_mkstate(dummy,dummy,bs,dummy)
  3966.                                         until bs=0
  3967.                                     end
  3968.                                 else
  3969.                                     begin
  3970.                                         Check;
  3971.                                         objc_offset(Class.ToolbarTree,Indx,bx,by);
  3972.                                         with brect do
  3973.                                             begin
  3974.                                                 X:=bx;
  3975.                                                 Y:=by;
  3976.                                                 W:=ObjAddr^.ob_width;
  3977.                                                 H:=ObjAddr^.ob_height
  3978.                                             end;
  3979.                                         repeat
  3980.                                             graf_mkstate(bx,by,bs,dummy);
  3981.                                             inrect:=false;
  3982.                                             with mrect do wind_get(Attr.gemHandle,WF_FIRSTXYWH,X,Y,W,H);
  3983.                                             while (mrect.W>0) and (mrect.H>0) do
  3984.                                                 begin
  3985.                                                     if rc_intersect(DRect,mrect) then
  3986.                                                         if rc_intersect(brect,mrect) then
  3987.                                                             with mrect do
  3988.                                                                 if (bx>=X1) and (by>=Y1) and (bx<=X2) and (by<=Y2) then
  3989.                                                                     begin
  3990.                                                                         inrect:=true;
  3991.                                                                         break
  3992.                                                                     end;
  3993.                                                     with mrect do wind_get(Attr.gemHandle,WF_NEXTXYWH,X,Y,W,H)
  3994.                                                 end;
  3995.                                             if inrect<>onbtn then
  3996.                                                 begin
  3997.                                                     Toggle;
  3998.                                                     onbtn:=inrect
  3999.                                                 end;
  4000.                                         until bs=0
  4001.                                     end;
  4002.                                 wind_update(END_MCTRL);
  4003.                                 wind_update(END_UPDATE);
  4004.                                 if onbtn then
  4005.                                     begin
  4006.                                         Work;
  4007.                                         if VPipe<>nil then
  4008.                                             begin
  4009.                                                 if VGHnd then VPipe^[3]:=Attr.gemHandle;
  4010.                                                 appl_write(Application^.apID,16,VPipe)
  4011.                                             end;
  4012.                                         if not(IsSwitch) then Uncheck
  4013.                                     end
  4014.                             end
  4015.                         else
  4016.                             if IsHelpAvailable then
  4017.                                 begin
  4018.                                     graf_mkstate(bx,by,dummy,dummy);
  4019.                                     Application^.BubbleHelp(bx,by,bbldelay,GetHelp)
  4020.                                 end;
  4021.                         exit
  4022.                     end
  4023.             else
  4024.                 p:=p^.Nxt
  4025.     end;
  4026.  
  4027.  
  4028. function TWindow.WMKeyDown(Stat,Key: integer): boolean;
  4029.  
  4030.     begin
  4031.         WMKeyDown:=false
  4032.     end;
  4033.  
  4034.  
  4035. procedure TWindow.WMDragDrop(PipeHnd,OrgID,mX,mY,KStat: integer);
  4036.     label _readhdr,_prefext;
  4037.  
  4038.     var answer           : string;
  4039.         hdrlen,i         : integer;
  4040.         dtype            : string[4];
  4041.         dsize            : longint;
  4042.         dname,ndata,nfile: string[DD_NAMEMAX];
  4043.  
  4044.     begin
  4045.         answer:=chr(DD_OK);
  4046.         if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  4047.         _prefext:
  4048.         answer:=StrPLeft(DDGetPreferredTypes,DD_EXTSIZE);
  4049.         while length(answer)<DD_EXTSIZE do answer:=answer+#0;
  4050.         if fwrite(PipeHnd,DD_EXTSIZE,@answer[1])<>DD_EXTSIZE then exit;
  4051.         _readhdr:
  4052.         if fread(PipeHnd,2,@hdrlen)<>2 then exit;
  4053.         if hdrlen<9 then exit;
  4054.         dtype:='    ';
  4055.         if fread(PipeHnd,4,@dtype[1])<>4 then exit;
  4056.         if fread(PipeHnd,4,@dsize)<>4 then exit;
  4057.         dec(hdrlen,8);
  4058.         if hdrlen>DD_NAMEMAX then i:=DD_NAMEMAX
  4059.         else
  4060.             i:=hdrlen;
  4061.         fillchar(dname,sizeof(dname),0);
  4062.         if fread(PipeHnd,i,@dname[1])<>i then exit;
  4063.         dec(hdrlen,i);
  4064.         ndata:='';
  4065.         nfile:='';
  4066.         i:=1;
  4067.         while dname[i]<>#0 do
  4068.             begin
  4069.                 ndata:=ndata+dname[i];
  4070.                 inc(i)
  4071.             end;
  4072.         inc(i);
  4073.         while dname[i]<>#0 do
  4074.             begin
  4075.                 nfile:=nfile+dname[i];
  4076.                 inc(i)
  4077.             end;
  4078.         while hdrlen>DD_NAMEMAX+1 do
  4079.             begin
  4080.                 if fread(PipeHnd,DD_NAMEMAX+1,@dname)<>DD_NAMEMAX+1 then exit;
  4081.                 dec(hdrlen,DD_NAMEMAX+1)
  4082.             end;
  4083.         if hdrlen>0 then
  4084.             if fread(PipeHnd,hdrlen,@dname)<>hdrlen then exit;
  4085.         if dtype='PATH' then
  4086.             begin
  4087.                 answer:=StrPTrimF(DDGetPath);
  4088.                 if length(answer)=0 then answer:=chr(DD_NAK)
  4089.                 else
  4090.                     answer:=StrPLeft(chr(DD_OK)+answer,dsize);
  4091.                 fwrite(PipeHnd,length(answer),@answer[1]);
  4092.                 exit
  4093.             end;
  4094.         if dtype='ARGS' then
  4095.             begin
  4096.                 answer:=chr(DD_OK);
  4097.                 if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  4098.                 if dsize>0 then
  4099.                     if DDReadArgs(dsize,PipeHnd,OrgID,mX,mY,KStat) then Application^.ddokflag:=true;
  4100.                 exit
  4101.             end;
  4102.         answer:=chr(DDHeaderReply(dtype,ndata,nfile,dsize,OrgID,mX,mY,KStat));
  4103.         if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  4104.         case ord(answer[1]) of
  4105.             DD_OK:  if DDReadData(dtype,ndata,nfile,dsize,PipeHnd,OrgID,mX,mY,KStat) then Application^.ddokflag:=true;
  4106.             DD_EXT: goto _readhdr;
  4107.             DD_LEN: goto _prefext
  4108.         end
  4109.     end;
  4110.  
  4111.  
  4112. procedure TWindow.WMIconify(iX,iY,iW,iH: integer);
  4113.  
  4114.     begin
  4115.         if Attr.Status<>ws_Open then exit;
  4116.         form_dial(FMD_SHRINK,iX,iY,iW,iH,Curr.X,Curr.Y,Curr.W,Curr.H);
  4117.         if icfpos>=0 then
  4118.             begin
  4119.                 icfstyle:=Attr.Style;
  4120.                 WMSized(iX,iY,iW,iH);
  4121.                 SetGadgets(NAME+MOVER)
  4122.             end
  4123.         else
  4124.             wind_set(Attr.gemHandle,WF_ICONIFY,iX,iY,iW,iH);
  4125.         DisposeStr(icntitl);
  4126.         icntitl:=NewStr(StrPLeft(StrPTrimF(GetIconTitle),10)+#0);
  4127.       if bTst(Attr.Style,NAME) then
  4128.             wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@icntitl^[1])),integer(LoWord(@icntitl^[1])),0,0);
  4129.         GetCurr;
  4130.         GetWork
  4131.     end;
  4132.  
  4133.  
  4134. procedure TWindow.WMUniconify(oX,oY,oW,oH: integer);
  4135.     var ICFFreePos: procedure(d1,d2: pointer; d3,d4,d5: longint; fn,posnr: integer);
  4136.  
  4137.     begin
  4138.         if Attr.Status<>ws_Open then exit;
  4139.         form_dial(FMD_GROW,Curr.X,Curr.Y,Curr.W,Curr.H,oX,oY,oW,oH);
  4140.         if icfpos>=0 then
  4141.             begin
  4142.                 SetGadgets(icfstyle);
  4143.                 WMSized(oX,oY,oW,oH)
  4144.             end
  4145.         else
  4146.             wind_set(Attr.gemHandle,WF_UNICONIFY,oX,oY,oW,oH);
  4147.       if bTst(Attr.Style,NAME) then
  4148.             wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@Attr.Title^[1])),integer(LoWord(@Attr.Title^[1])),0,0);
  4149.         DisposeStr(icntitl);
  4150.         if icfpos>=0 then
  4151.             begin
  4152.                 ICFFreePos:=icfserver;
  4153.                 ICFFreePos(nil,nil,0,0,0,ICF_FREEPOS,icfpos);
  4154.                 icfpos:=-1
  4155.             end;
  4156.         GetCurr;
  4157.         GetWork
  4158.     end;
  4159.  
  4160.  
  4161. procedure TWindow.WAUpPage;
  4162.  
  4163.     begin
  4164.         if Scroller<>nil then
  4165.             Scroller^.ScrollBy(0,-Scroller^.YPage)
  4166.     end;
  4167.  
  4168.  
  4169. procedure TWindow.WADnPage;
  4170.  
  4171.     begin
  4172.         if Scroller<>nil then
  4173.             Scroller^.ScrollBy(0,Scroller^.YPage)
  4174.     end;
  4175.  
  4176.  
  4177. procedure TWindow.WAUpLine;
  4178.  
  4179.     begin
  4180.         if Scroller<>nil then
  4181.             Scroller^.ScrollBy(0,-Scroller^.YLine)
  4182.     end;
  4183.  
  4184.  
  4185. procedure TWindow.WADnLine;
  4186.  
  4187.     begin
  4188.         if Scroller<>nil then
  4189.             Scroller^.ScrollBy(0,Scroller^.YLine)
  4190.     end;
  4191.  
  4192.  
  4193. procedure TWindow.WALfPage;
  4194.  
  4195.     begin
  4196.         if Scroller<>nil then
  4197.             Scroller^.ScrollBy(-Scroller^.XPage,0)
  4198.     end;
  4199.  
  4200.  
  4201. procedure TWindow.WARtPage;
  4202.  
  4203.     begin
  4204.         if Scroller<>nil then
  4205.             Scroller^.ScrollBy(Scroller^.XPage,0)
  4206.     end;
  4207.  
  4208.  
  4209. procedure TWindow.WALfLine;
  4210.  
  4211.     begin
  4212.         if Scroller<>nil then
  4213.             Scroller^.ScrollBy(-Scroller^.XLine,0)
  4214.     end;
  4215.  
  4216.  
  4217. procedure TWindow.WARtLine;
  4218.  
  4219.     begin
  4220.         if Scroller<>nil then
  4221.             Scroller^.ScrollBy(Scroller^.XLine,0)
  4222.     end;
  4223.  
  4224.  
  4225. function TWindow.DDGetPreferredTypes: string;
  4226.  
  4227.     begin
  4228.         DDGetPreferredTypes:=Application^.DDGetPreferredTypes(Attr.gemHandle)
  4229.     end;
  4230.  
  4231.  
  4232. function TWindow.DDGetPath: string;
  4233.  
  4234.     begin
  4235.         DDGetPath:=''
  4236.     end;
  4237.  
  4238.  
  4239. function TWindow.DDHeaderReply(dType,dName,fName: string; dSize: longint; OrgID,mX,mY,KStat: integer): byte;
  4240.  
  4241.     begin
  4242.         DDHeaderReply:=DD_NAK
  4243.     end;
  4244.  
  4245.  
  4246. function TWindow.DDReadData(dType,dName,fName: string; dSize: longint; PipeHnd,OrgID,mX,mY,KStat: integer): boolean;
  4247.  
  4248.     begin
  4249.         DDReadData:=false
  4250.     end;
  4251.  
  4252.  
  4253. function TWindow.DDReadArgs(dSize: longint; PipeHnd,OrgID,mX,mY,KStat: integer): boolean;
  4254.     var buffer: array [0..127] of byte;
  4255.  
  4256.     begin
  4257.         DDReadArgs:=false;
  4258.         if dSize<=0 then exit;
  4259.         while dSize>128 do
  4260.             begin
  4261.                 if fread(PipeHnd,128,@buffer)<>128 then exit;
  4262.                 dec(dSize,128)
  4263.             end;
  4264.         fread(PipeHnd,dSize,@buffer)
  4265.     end;
  4266.  
  4267.  
  4268. procedure TWindow.DDFinished(OrgID,mX,mY,KStat: integer);
  4269.  
  4270.     begin
  4271.     end;
  4272.  
  4273.  
  4274. function TWindow.Previous: PWindow;
  4275.  
  4276.     begin
  4277.         Previous:=Prev
  4278.     end;
  4279.  
  4280.  
  4281. function TWindow.Next: PWindow;
  4282.  
  4283.     begin
  4284.         Next:=Nxt
  4285.     end;
  4286.  
  4287.  
  4288. function TWindow.At(Index: integer): PWindow;
  4289.     var len: integer;
  4290.         p  : PWindow;
  4291.  
  4292.     begin
  4293.         len:=0;
  4294.         p:=ChildList;
  4295.         while p<>nil do
  4296.             begin
  4297.                 inc(len);
  4298.                 p:=p^.Nxt
  4299.             end;
  4300.         At:=nil;
  4301.         if (Index<0) or (len=0) then exit;
  4302.         Index:=Index mod len;
  4303.         p:=ChildList;
  4304.         if Index>0 then
  4305.             for len:=0 to Index-1 do p:=p^.Nxt;
  4306.         At:=p
  4307.     end;
  4308.  
  4309.  
  4310. function TWindow.IndexOf(Item: PWindow): integer;
  4311.     var count: integer;
  4312.         p    : PWindow;
  4313.  
  4314.     begin
  4315.         IndexOf:=-1;
  4316.         count:=0;
  4317.         p:=ChildList;
  4318.         while p<>nil do
  4319.             begin
  4320.                 if p=Item then
  4321.                     begin
  4322.                         IndexOf:=count;
  4323.                         exit
  4324.                     end;
  4325.                 inc(count);
  4326.                 p:=p^.Nxt
  4327.             end
  4328.     end;
  4329.  
  4330.  
  4331. function TWindow.FirstWndThat(Test: PIterationFunc): PWindow;
  4332.     var p,pc: PWindow;
  4333.         cl  : IterationFunc;
  4334.  
  4335.     begin
  4336.         FirstWndThat:=nil;
  4337.         p:=ChildList;
  4338.         cl:=IterationFunc(Test);
  4339.         while p<>nil do
  4340.             begin
  4341.                 if cl(p) then
  4342.                     begin
  4343.                         FirstWndThat:=p;
  4344.                         exit
  4345.                     end;
  4346.                 pc:=p^.FirstWndThat(Test);
  4347.                 if pc<>nil then
  4348.                     begin
  4349.                         FirstWndThat:=pc;
  4350.                         exit
  4351.                     end;
  4352.                 p:=p^.Nxt
  4353.             end;
  4354.     end;
  4355.  
  4356.  
  4357. procedure TWindow.ForEachWnd(Action: PIterationProc);
  4358.     var p : PWindow;
  4359.         cl: IterationProc;
  4360.  
  4361.     begin
  4362.         p:=ChildList;
  4363.         cl:=IterationProc(Action);
  4364.         while p<>nil do
  4365.             begin
  4366.                 cl(p);
  4367.                 p^.ForEachWnd(Action);
  4368.                 p:=p^.Nxt
  4369.             end
  4370.     end;
  4371.  
  4372.  
  4373. function TWindow.FirstWorkRect(var Rect: GRECT): boolean;
  4374.  
  4375.     begin
  4376.         if Attr.Status=ws_Open then
  4377.             begin
  4378.                 GetWork;
  4379.                 with Rect do wind_get(Attr.gemHandle,WF_FIRSTXYWH,X,Y,W,H);
  4380.                 while (Rect.W>0) and (Rect.H>0) do
  4381.                     begin
  4382.                         if rc_intersect(DRect,Rect) then
  4383.                             if rc_intersect(Work,Rect) then
  4384.                                 begin
  4385.                                     FirstWorkRect:=true;
  4386.                                     exit
  4387.                                 end;
  4388.                         with Rect do wind_get(Attr.gemHandle,WF_NEXTXYWH,X,Y,W,H)
  4389.                     end
  4390.             end;
  4391.         FirstWorkRect:=false;
  4392.         Rect.W:=0
  4393.     end;
  4394.  
  4395.  
  4396. function TWindow.NextWorkRect(var Rect: GRECT): boolean;
  4397.  
  4398.     begin
  4399.         if Attr.Status=ws_Open then
  4400.             begin
  4401.                 with Rect do wind_get(Attr.gemHandle,WF_NEXTXYWH,X,Y,W,H);
  4402.                 while (Rect.W>0) and (Rect.H>0) do
  4403.                     begin
  4404.                         if rc_intersect(DRect,Rect) then
  4405.                             if rc_intersect(Work,Rect) then
  4406.                                 begin
  4407.                                     NextWorkRect:=true;
  4408.                                     exit
  4409.                                 end;
  4410.                         with Rect do wind_get(Attr.gemHandle,WF_NEXTXYWH,X,Y,W,H)
  4411.                     end
  4412.             end;
  4413.         NextWorkRect:=false;
  4414.         Rect.W:=0
  4415.     end;
  4416.  
  4417.  
  4418.     { private }
  4419.  
  4420.  
  4421. procedure TWindow.EnableCrsWatch;
  4422.  
  4423.     begin
  4424.         if Application^.pcrswatch<>@self then
  4425.             begin
  4426.                 if Application^.pcrswatch<>nil then
  4427.                     with Application^ do
  4428.                         begin
  4429.                             pcrswatch:=nil;
  4430.                             Attr.EventMask:=Attr.EventMask and not(MU_M1 or MU_M2);
  4431.                             if not(IsMouseBusy) then graf_mouse(wmnr,@wmform)
  4432.                         end;
  4433.                 if Class.hCursor>id_No then
  4434.                     begin
  4435.                         Application^.pcrswatch:=@self;
  4436.                         Application^.Attr.EventMask:=Application^.Attr.EventMask or MU_M1
  4437.                     end
  4438.             end
  4439.     end;
  4440.  
  4441.  
  4442. procedure TWindow.DisableCrsWatch;
  4443.     var p: PWindow;
  4444.  
  4445.     begin
  4446.         if Application^.pcrswatch=@self then
  4447.             begin
  4448.                 with Application^ do
  4449.                     begin
  4450.                         pcrswatch:=nil;
  4451.                         Attr.EventMask:=Attr.EventMask and not(MU_M1 or MU_M2);
  4452.                         if not(IsMouseBusy) then graf_mouse(wmnr,@wmform);
  4453.                         p:=GetPTopWindow
  4454.                     end;
  4455.                 if (p<>nil) and (p<>@self) then p^.EnableCrsWatch
  4456.             end
  4457.     end;
  4458.  
  4459.  
  4460. procedure TWindow.Iconify(fade: boolean);
  4461.  
  4462.     begin
  4463.         if fade then
  4464.             begin
  4465.                 icnx:=Curr.X;
  4466.                 WMMoved(DRect.X+DRect.W+20,Curr.Y,Curr.W,Curr.H)
  4467.             end
  4468.         else
  4469.             WMMoved(icnx,Curr.Y,Curr.W,Curr.H)
  4470.     end;
  4471.  
  4472. { *** TWINDOW *** }
  4473.  
  4474.  
  4475.  
  4476. { *** Objekt TAPPLICATION *** }
  4477.  
  4478. constructor TApplication.Init(AnID: TCookieID; AName: string);
  4479.     const fontset: AESOBJECT = (ob_next:-1;ob_head:-1;ob_tail:-1;ob_type:G_STRING;
  4480.                                   ob_flags:LASTOB;ob_state:NORMAL;ob_spec:(free_string:PChar(' '));
  4481.                                   ob_x:10;ob_y:10;ob_width:1;ob_height:1);
  4482.  
  4483.   var gval : longint;
  4484.           dummy: integer;
  4485.           fdst : ARRAY_5;
  4486.           ffx  : ARRAY_3;
  4487.           atrb : ARRAY_10;
  4488.           scmd : string;
  4489.           pipe : Pipearray;
  4490.           meta : METAINFO;
  4491.           xdsc : boolean;
  4492.           dst  : PChar;
  4493.           env  : pointer;
  4494.  
  4495.     function get_objsysvar(what,ver: integer): integer;
  4496.  
  4497.         begin
  4498.             get_objsysvar:=White;
  4499.             if not(bTst(Attr.Style,as_3DFlags)) then exit;
  4500.             if GEMVersion>=$401 then
  4501.                 begin
  4502.                     with AES_pb do
  4503.                         begin
  4504.                             control^[0]:=48;
  4505.                             control^[1]:=4;
  4506.                             control^[3]:=0;
  4507.                             intin^[0]:=0;
  4508.                             intin^[1]:=what;
  4509.                             intin^[2]:=0;
  4510.                             intin^[3]:=0
  4511.                         end;
  4512.                     _crystal(@AES_pb);
  4513.                     if AES_pb.intout^[0]>0 then get_objsysvar:=AES_pb.intout^[1]
  4514.                     else
  4515.                         if Attr.Colors>=LWhite then get_objsysvar:=LWhite
  4516.                 end
  4517.             else
  4518.                 if (TOSVersion>=ver) and (Attr.Colors>=LWhite) then get_objsysvar:=LWhite
  4519.         end;
  4520.  
  4521.   begin
  4522.     if not(inherited Init) then fail;
  4523.     termflag:=false;
  4524.     appdone:=true;
  4525.     Application:=@self;
  4526.     if AppFlag then Fsetdta(@apDTA);
  4527.     apName:=nil;
  4528.     apPath:=nil;
  4529.     pquit:=nil;
  4530.     xaccname:=nil;
  4531.     XAccList:=nil;
  4532.     icnwnd:=nil;
  4533.     allicn:=false;
  4534.     ID:=AnID;
  4535.     Name:=NewStr(AName);
  4536.     Status:=em_OK;
  4537.     Err:=em_OK;
  4538.     FirstInstance:=false;
  4539.     MainWindow:=nil;
  4540.     RscPtr:=nil;
  4541.     MenuTree:=nil;
  4542.     MessageBuffer:=nil;
  4543.     MessageBLen:=0;
  4544.     pcrswatch:=nil;
  4545.     icfserver:=nil;
  4546.     menuID:=-1;
  4547.     apID:=-1;
  4548.     vdiHandle:=-1;
  4549.     aesHandle:=-1;
  4550.     AVServer:=id_No;
  4551.     HMax:=-1;
  4552.     spderr:=0;
  4553.     GDOSActive:=false;
  4554.     MultiTOS:=false;
  4555.     IsQSBUsed:=false;
  4556.     DlgTop:=-1;
  4557.         with Attr do
  4558.             begin
  4559.                 Instance:=$42;
  4560.                 if GetCookie('_AKP',gval) then Country:=gval and $ff
  4561.                 else
  4562.                     Country:=PWord(longint(GetOSHeaderPtr)+28)^ shr 1;
  4563.                 rpCmd:=nil;
  4564.                 rpTail:=nil
  4565.             end;
  4566.         FPUAvailable:=(Test68881<>0);
  4567.         if not(FPUAvailable) then
  4568.             if GetCookie('_FPU',gval) then
  4569.                 FPUAvailable:=((gval and $ffff)<>0) or ((gval and $ffff0000)>$00010000);
  4570.         OSBAvailable:=GetCookie('EdDI',gval);
  4571.         if GetCookie('FSMC',gval) then SpeedoActive:=(PLongint(gval)^=1599295556)
  4572.         else
  4573.             SpeedoActive:=false;
  4574.         if not(GetCookie('HELP',gval)) then
  4575.             begin
  4576.                 NewCookie('HELP',$01f4ffff);
  4577.                 bbldelay:=500
  4578.             end
  4579.         else
  4580.             bbldelay:=(gval shr 16) and $ffff;
  4581.         MiNTActive:=(MiNTVersion>0);
  4582.         fillchar(meta,sizeof(meta),0);
  4583.         metainit(meta);
  4584.         if meta.version=nil then MetaDOS:=nil
  4585.         else
  4586.             begin
  4587.                 new(MetaDOS);
  4588.                 MetaDOS^.Drives:=meta.drivemap;
  4589.                 MetaDOS^.Version:=StrPas(meta.version)
  4590.             end;
  4591.     InitGem;
  4592.     if Status>=em_OK then
  4593.         begin
  4594.             wind_update(BEG_UPDATE);
  4595.                 if GetCookie('ICFS',gval) and (GEMVersion<$0410) then icfserver:=pointer(gval);
  4596.             GetDesk(DRect);
  4597.             scmd:='';
  4598.           with Attr do
  4599.               begin
  4600.                   MaxPX:=workOut[0];
  4601.                   MaxPY:=workOut[1];
  4602.                   PixW:=workOut[3];
  4603.                   PixH:=workOut[4];
  4604.                   Colors:=workOut[13];
  4605.                   MaxColors:=workOut[39];
  4606.                   sysFonts:=workOut[10];
  4607.                   addFonts:=0;
  4608.                   Planes:=GEM_pb.global[10];
  4609.                         EventMask:=MU_MESAG or MU_KEYBD or MU_BUTTON;
  4610.                         if MultiTOS then EventMask:=EventMask or MU_TIMER;
  4611.                   Style:=as_GrowShrink or as_MenuSeparator or as_MoveDials or as_HandleShutdown or as_3DFlags;
  4612.                         if rpCmd<>nil then
  4613.                             begin
  4614.                                 scmd:=StrPRight(rpCmd^,length(rpCmd^)-RPos('\',rpCmd^));
  4615.                                 if pos('.',scmd)>0 then scmd:=StrPLeft(scmd,pos('.',scmd)-1);
  4616.                                 scmd:=StrPLeft(scmd,8);
  4617.                                 apPath:=NewStr(StrPLeft(rpCmd^,RPos('\',rpCmd^)))
  4618.                             end
  4619.                     end;
  4620.                 if SpeedoActive then vst_error(vdiHandle,0,spderr);
  4621.                 apName:=NewStr(scmd+StrPSpace(8-length(scmd))+#0);
  4622.                 objc_draw(@fontset,ROOT,0,0,0,1,1);
  4623.                 vqt_attributes(aesHandle,atrb);
  4624.                 SysInfo.SFHeight:=atrb[7];
  4625.                 SysInfo.SFWidth:=atrb[8];
  4626.                 if SysInfo.SFHeight<6 then
  4627.                     begin
  4628.                         if (Attr.MaxPX<639) or (Attr.MaxPY<399) then gem.vst_point(vdiHandle,9,dummy,dummy,dummy,dummy)
  4629.                         else
  4630.                             gem.vst_point(vdiHandle,10,dummy,dummy,dummy,dummy);
  4631.                         vqt_fontinfo(vdiHandle,dummy,dummy,fdst,SysInfo.SFWidth,ffx);
  4632.                         SysInfo.SFHeight:=fdst[4]
  4633.                     end;
  4634.                 GDOSActive:=(vq_gdos<>0);
  4635.                 SysInfo.BGDefCol:=get_objsysvar(BACKGRCOL,$0404);
  4636.                 bfalcol:=get_objsysvar(ACTBUTCOL,$0100);
  4637.           SetupVDI;
  4638.                 if Status>=em_OK then
  4639.                     begin
  4640.                         SysInfo.BGDefCol:=get_objsysvar(BACKGRCOL,$0404);
  4641.                         bfalcol:=get_objsysvar(ACTBUTCOL,$0100);
  4642.                         gval:=0;
  4643.                         GetXAccAttr(XAcc);
  4644.                         with XAcc do
  4645.                             begin
  4646.                                 if AppTypeHR=nil then AppTypeHR:=NewStr(XAccMR2HR(AppTypeMR));
  4647.                                 if length(AppTypeMR)>0 then inc(gval,length(AppTypeMR)+2);
  4648.                                 if AppTypeHR<>nil then inc(gval,length(AppTypeHR^)+2);
  4649.                                 if ExtFeatures<>nil then inc(gval,length(ExtFeatures^)+2);
  4650.                                 if GenericName<>nil then inc(gval,length(GenericName^)+2)
  4651.                             end;
  4652.                         if gval>0 then inc(gval,5);
  4653.                         xdsc:=(gval>0);
  4654.                         inc(gval,length(Name^)+2);
  4655.                         if MiNTActive then xaccname:=mxalloc(gval,GLOBAL)
  4656.                         else
  4657.                             xaccname:=malloc(gval);
  4658.                         if xaccname<>nil then
  4659.                             begin
  4660.                                 if xdsc then
  4661.                                     begin
  4662.                                         StrPCopy(xaccname,Name^+#0'XDSC');
  4663.                                         dst:=PChar(longint(xaccname)+length(Name^)+6);
  4664.                                         with XAcc do
  4665.                                             begin
  4666.                                                 pXDSC:=dst;
  4667.                                                 if AppTypeHR<>nil then
  4668.                                                     begin
  4669.                                                         StrPCopy(dst,'1'+AppTypeHR^);
  4670.                                                         dst:=PChar(longint(dst)+length(AppTypeHR^)+2)
  4671.                                                     end;
  4672.                                                 if length(AppTypeMR)>0 then
  4673.                                                     begin
  4674.                                                         StrPCopy(dst,'2'+AppTypeMR);
  4675.                                                         dst:=PChar(longint(dst)+length(AppTypeMR)+2)
  4676.                                                     end;
  4677.                                                 if ExtFeatures<>nil then
  4678.                                                     begin
  4679.                                                         StrPCopy(dst,'X'+ExtFeatures^);
  4680.                                                         dst:=PChar(longint(dst)+length(ExtFeatures^)+2)
  4681.                                                     end;
  4682.                                                 if GenericName<>nil then
  4683.                                                     begin
  4684.                                                         StrPCopy(dst,'N'+GenericName^);
  4685.                                                         dst:=PChar(longint(dst)+length(GenericName^)+2)
  4686.                                                     end
  4687.                                             end;
  4688.                                         dst^:=#0
  4689.                                     end
  4690.                                 else
  4691.                                     StrPCopy(xaccname,Name^+#0)
  4692.                             end;
  4693.                 if not(GetCookie(ID,gval)) then InitApplication
  4694.                 else
  4695.                   begin
  4696.                       if (gval and $ffffff00)=getcval then
  4697.                           begin
  4698.                               Attr.Instance:=(gval and $ff)+1;
  4699.                                     ChangeCookie(ID,getcval+Attr.Instance)
  4700.                           end
  4701.                       else
  4702.                           begin
  4703.                               Attr.Instance:=0;
  4704.                               InitApplication
  4705.                           end
  4706.                   end;
  4707.                 if Status>=em_OK then InitInstance;
  4708.                         if MultiTOS then
  4709.                             if Status>=em_OK then
  4710.                             begin
  4711.                                     pipe[0]:=ACC_ID;
  4712.                                     pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  4713.                                     pipe[4]:=integer(HiWord(xaccname));
  4714.                                     pipe[5]:=integer(LoWord(xaccname));
  4715.                                     pipe[6]:=menuID;
  4716.                                     pipe[7]:=0;
  4717.                                     Broadcast(@pipe,true);
  4718.                                     dummy:=appl_find('GEMINI  ');
  4719.                                     if dummy<0 then dummy:=appl_find('AVSERVER');
  4720.                                     if dummy<0 then
  4721.                                         begin
  4722.                                             shel_envrn(env,'AVSERVER=');
  4723.                                             if env<>nil then
  4724.                                                 begin
  4725.                                                     scmd:=StrPLeft(StrPTrimF(StrPas(env)),8);
  4726.                                                     dummy:=appl_find(scmd+StrPSpace(8-length(scmd)))
  4727.                                                 end
  4728.                                         end;
  4729.                                     if dummy>=0 then
  4730.                                         begin
  4731.                                             pipe[0]:=AV_PROTOKOLL;
  4732.                                             pipe[1]:=apID;
  4733.                                             pipe[2]:=0;
  4734.                                             pipe[3]:=integer(XAcc.AVAccMsg);
  4735.                                             pipe[4]:=0;
  4736.                                             pipe[5]:=0;
  4737.                                             pipe[6]:=integer((longint(apName)+1) div 65536);
  4738.                                             pipe[7]:=integer((longint(apName)+1) mod 65536);
  4739.                                             appl_write(dummy,16,@pipe)
  4740.                                         end
  4741.                                 end
  4742.                     end;
  4743.                 wind_update(END_UPDATE)
  4744.       end
  4745.   end;
  4746.  
  4747.  
  4748. destructor TApplication.Done;
  4749.     var ci  : integer;
  4750.  
  4751.     begin
  4752.         appdone:=false;
  4753.         while (MainWindow<>nil) do MainWindow^.Free;
  4754.         if termflag then Terminate;
  4755.         ClosePrivateProfile;
  4756.         if Attr.Instance>0 then
  4757.             begin
  4758.                 ci:=GetCurrInstance;
  4759.                 if ci>=2 then ChangeCookie(ID,getcval+ci-1)
  4760.                 else
  4761.                     RemoveCookie(ID)
  4762.             end;
  4763.         if XAccList<>nil then
  4764.             begin
  4765.                 XAccList^.ForEach(@SendXAccExit);
  4766.                 dispose(PXAccCollection(XAccList),Done);
  4767.                 XAccList:=nil
  4768.             end;
  4769.         if not(AppFlag or MultiTOS) then while true do evnt_timer(0,1);
  4770.         ExitGem;
  4771.         Application:=nil;
  4772.         DisposeStr(Attr.rpTail);
  4773.         DisposeStr(Attr.rpCmd);
  4774.         DisposeStr(XAcc.AppTypeHR);
  4775.         DisposeStr(XAcc.ExtFeatures);
  4776.         DisposeStr(XAcc.GenericName);
  4777.         DisposeStr(apName);
  4778.         DisposeStr(apPath);
  4779.     DisposeStr(Name);
  4780.         if xaccname<>nil then mfree(xaccname);
  4781.     inherited Done
  4782.   end;
  4783.  
  4784.  
  4785. function TApplication.CanClose: boolean;
  4786.     var p    : PWindow;
  4787.         valid: boolean;
  4788.  
  4789.     begin
  4790.         if (AppFlag or MultiTOS) then
  4791.           begin
  4792.               p:=MainWindow;
  4793.               valid:=true;
  4794.               while (p<>nil) and valid do
  4795.                   with p^ do
  4796.                       begin
  4797.                           if Attr.Status=ws_Open then
  4798.                               if not(CanClose) then valid:=false;
  4799.                           p:=Nxt
  4800.                       end;
  4801.               CanClose:=valid
  4802.           end
  4803.         else
  4804.             CanClose:=false
  4805.     end;
  4806.  
  4807.  
  4808. function TApplication.IsIconified: boolean;
  4809.  
  4810.     begin
  4811.         IsIconified:=allicn
  4812.     end;
  4813.  
  4814.  
  4815. procedure TApplication.LoadResource(FileHiRes,FileLoRes: string);
  4816.     var vald: boolean;
  4817.  
  4818.     begin
  4819.         if RscPtr=nil then
  4820.             begin
  4821.                 if Attr.MaxPY>=399 then
  4822.                     begin
  4823.                         if rsrc_load(FileHiRes)=0 then vald:=(rsrc_load(FileLoRes)<>0)
  4824.                         else
  4825.                             vald:=true
  4826.                     end
  4827.                 else
  4828.                     begin
  4829.                         if rsrc_load(FileLoRes)=0 then vald:=(rsrc_load(FileHiRes)<>0)
  4830.                         else
  4831.                             vald:=true
  4832.                     end;
  4833.                 if vald then
  4834.                     begin
  4835.                         RscPtr:=RSC_LOADED;
  4836.                         FixResource(Ptr(word(GEM_pb.global[7]),word(GEM_pb.global[8])),FIXRSC,FIX_BBONLY)
  4837.                     end
  4838.                 else
  4839.                     begin
  4840.                         RscPtr:=nil;
  4841.                         Status:=em_RscNotFound;
  4842.                         Err:=Status;
  4843.                         Error(Err)
  4844.                     end
  4845.             end
  4846.     end;
  4847.  
  4848.  
  4849. procedure TApplication.InitResource(AddrHiRes,AddrLoRes: pointer);
  4850.     var pool: AESTreePtrArrayPtr;
  4851.  
  4852.     begin
  4853.         if (RscPtr=nil) and ((AddrHiRes<>nil) or (AddrLoRes<>nil)) then
  4854.             begin
  4855.               if AddrHiRes=nil then AddrHiRes:=AddrLoRes;
  4856.               if AddrLoRes=nil then AddrLoRes:=AddrHiRes;
  4857.               if Attr.MaxPY>=399 then RscPtr:=AddrHiRes
  4858.               else
  4859.                 RscPtr:=AddrLoRes;
  4860.                 FixResource(RscPtr,FIXRSC,FIX_ALL);
  4861.                 pool:=@RscPtr^.rsd[RscPtr^.rsh.rsh_trindex];
  4862.                 with GEM_pb do
  4863.                     begin
  4864.                         global[5]:=integer(HiWord(pool));
  4865.                         global[6]:=integer(LoWord(pool));
  4866.                         global[7]:=integer(HiWord(RscPtr));
  4867.                         global[8]:=integer(LoWord(RscPtr));
  4868.                         global[9]:=integer(RscPtr^.rsh.rsh_rssize)
  4869.                     end
  4870.             end
  4871.     end;
  4872.  
  4873.  
  4874. function TApplication.GetAddr(Indx: integer): PTree;
  4875.     var tree: pointer;
  4876.  
  4877.     begin
  4878.         if RscPtr<>nil then
  4879.             begin
  4880.                 if RscPtr=RSC_LOADED then
  4881.                     begin
  4882.                         if rsrc_gaddr(R_TREE,Indx,tree)<>0 then
  4883.                             GetAddr:=tree
  4884.                         else
  4885.                             GetAddr:=nil
  4886.                     end
  4887.                 else
  4888.                     GetAddr:=AESTreePtrArrayPtr(@RscPtr^.rsd[RscPtr^.rsh.rsh_trindex])^[Indx]
  4889.             end
  4890.         else
  4891.             GetAddr:=nil
  4892.     end;
  4893.  
  4894.  
  4895. function TApplication.GetFImagePtr(Indx: integer): pointer;
  4896.     var imgptr: pointer;
  4897.  
  4898.     begin
  4899.         if RscPtr<>nil then
  4900.             begin
  4901.                 if RscPtr=RSC_LOADED then
  4902.                     begin
  4903.                         if rsrc_gaddr(R_FRIMG,ROOT,imgptr)=0 then GetFImagePtr:=nil
  4904.                         else
  4905.                             GetFImagePtr:=FreeImgPtrArrayPtr(imgptr)^[Indx]
  4906.                     end
  4907.                 else
  4908.                     begin
  4909.                         if (Indx>=0) and (Indx<RscPtr^.rsh.rsh_nimages) then
  4910.                             GetFImagePtr:=FreeImgPtrArrayPtr(@RscPtr^.rsd[RscPtr^.rsh.rsh_frimg])^[Indx]
  4911.                         else
  4912.                             GetFImagePtr:=nil
  4913.                     end
  4914.             end
  4915.         else
  4916.             GetFImagePtr:=nil
  4917.     end;
  4918.  
  4919.  
  4920. function TApplication.GetFStringPtr(Indx: integer): PChar;
  4921.     var strptr: pointer;
  4922.  
  4923.     begin
  4924.         if RscPtr<>nil then
  4925.             begin
  4926.                 if RscPtr=RSC_LOADED then
  4927.                     begin
  4928.                         if rsrc_gaddr(R_FRSTR,ROOT,strptr)=0 then GetFStringPtr:=nil
  4929.                         else
  4930.                             GetFStringPtr:=FreeStrPtrArrayPtr(strptr)^[Indx]
  4931.                     end
  4932.                 else
  4933.                     begin
  4934.                         if (Indx>=0) and (Indx<RscPtr^.rsh.rsh_nstring) then
  4935.                             GetFStringPtr:=FreeStrPtrArrayPtr(@RscPtr^.rsd[RscPtr^.rsh.rsh_frstr])^[Indx]
  4936.                         else
  4937.                             GetFStringPtr:=nil
  4938.                     end
  4939.             end
  4940.         else
  4941.             GetFStringPtr:=nil
  4942.     end;
  4943.  
  4944.  
  4945. function TApplication.GetFString(Indx: integer): string;
  4946.  
  4947.     begin
  4948.         GetFString:=StrPas(GetFStringPtr(Indx))
  4949.     end;
  4950.  
  4951.  
  4952. function TApplication.GetIconTitle: string;
  4953.  
  4954.     begin
  4955.         GetIconTitle:=Name^
  4956.     end;
  4957.  
  4958.  
  4959. procedure TApplication.GetXAccAttr(var XAccAttr: TXAccAttr);
  4960.  
  4961.     begin
  4962.         with XAccAttr do
  4963.             begin
  4964.                 Version:=0;
  4965.                 MsgGroups:=3;
  4966.                 Protocol:=PROTO_XACC+PROTO_AV;
  4967.                 AVSrvMsg:=1024;
  4968.                 AVAccMsg:=0;
  4969.                 AppTypeMR:='';
  4970.                 AppTypeHR:=nil;
  4971.                 ExtFeatures:=nil;
  4972.                 GenericName:=nil;
  4973.                 pXDSC:=nil
  4974.             end;
  4975.         XAccAttr.apID:=apID;
  4976.         XAccAttr.menuID:=menuID;
  4977.         XAccAttr.Name:=Name
  4978.     end;
  4979.  
  4980.  
  4981. procedure TApplication.Broadcast(Msg: pointer; sID: boolean);
  4982.     var p: PXAccAttr;
  4983.         q: integer;
  4984.  
  4985.     begin
  4986.         if Msg=nil then exit;
  4987.         if sID then PPipearray(Msg)^[1]:=apID;
  4988.         PPipearray(Msg)^[2]:=0;
  4989.         if MultiTOS then
  4990.             begin
  4991.                 with AES_pb do
  4992.                     begin
  4993.                         control^[0]:=121;
  4994.                         control^[1]:=3;
  4995.                         control^[3]:=2;
  4996.                         intin^[0]:=7;
  4997.                         intin^[1]:=0;
  4998.                         intin^[2]:=0;
  4999.                         addrin^[0]:=Msg;
  5000.                         addrin^[1]:=nil
  5001.                     end;
  5002.                 _crystal(@AES_pb)
  5003.             end
  5004.         else
  5005.             if XAccList<>nil then
  5006.                 with XAccList^ do
  5007.                     if Count>0 then
  5008.                         for q:=0 to Count-1 do
  5009.                             begin
  5010.                                 p:=At(q);
  5011.                                 if p<>nil then appl_write(p^.apID,16,Msg)
  5012.                             end
  5013.     end;
  5014.  
  5015.  
  5016. function TApplication.FindApplication(AName: string; AnID: integer; var XAccAttr: TXAccAttr): boolean;
  5017.     var p: PXAccAttr;
  5018.         q: longint;
  5019.  
  5020.     begin
  5021.         FindApplication:=false;
  5022.         lastfa:=-1;
  5023.         if (length(AName)=0) and (AnID<0) then exit;
  5024.         if XAccList<>nil then
  5025.             with XAccList^ do
  5026.                 if Count>0 then
  5027.                     for q:=0 to Count-1 do
  5028.                         begin
  5029.                             p:=At(q);
  5030.                             if p<>nil then
  5031.                                 begin
  5032.                                     if length(AName)>0 then
  5033.                                         begin
  5034.                                             if p^.Name^=AName then
  5035.                                                 begin
  5036.                                                     XAccAttr:=p^;
  5037.                                                     FindApplication:=true;
  5038.                                                     lastfa:=q;
  5039.                                                     exit
  5040.                                                 end
  5041.                                         end
  5042.                                     else
  5043.                                         if p^.apID=AnID then
  5044.                                             begin
  5045.                                                 XAccAttr:=p^;
  5046.                                                 FindApplication:=true;
  5047.                                                 lastfa:=q;
  5048.                                                 exit
  5049.                                             end
  5050.                                 end
  5051.                         end
  5052.     end;
  5053.  
  5054.  
  5055. procedure TApplication.FreeResource;
  5056.     var q: integer;
  5057.  
  5058.     begin
  5059.         if RscPtr<>nil then
  5060.             begin
  5061.                 if RscPtr=RSC_LOADED then
  5062.                     begin
  5063.                         if rsrc_free<>0 then
  5064.                             begin
  5065.                                 for q:=5 to 9 do GEM_pb.global[q]:=0;
  5066.                                 RscPtr:=nil
  5067.                             end
  5068.                     end
  5069.                 else
  5070.                     begin
  5071.                         FixResource(RscPtr,UNFIXRSC,FIX_ALL);
  5072.                         for q:=5 to 9 do GEM_pb.global[q]:=0;
  5073.                         RscPtr:=nil
  5074.                     end
  5075.             end
  5076.     end;
  5077.  
  5078.  
  5079. procedure TApplication.InstallDesktop(tIndx,oIndx: integer);
  5080.     var tp: PTree;
  5081.  
  5082.     begin
  5083.         tp:=GetAddr(tIndx);
  5084.         if (tp<>nil) and AppFlag then
  5085.             begin
  5086.                 with DRect do
  5087.                     begin
  5088.                         tp^[ROOT].ob_x:=X;
  5089.                         tp^[ROOT].ob_y:=Y;
  5090.                         tp^[ROOT].ob_width:=W;
  5091.                         tp^[ROOT].ob_height:=H
  5092.                     end;
  5093.                 wind_set(DESK,WF_NEWDESK,integer(HiWord(tp)),integer(LoWord(tp)),oIndx,0);
  5094.                 DeskRedraw
  5095.             end
  5096.     end;
  5097.  
  5098.  
  5099. procedure TApplication.RemoveDesktop;
  5100.  
  5101.     begin
  5102.         if AppFlag then
  5103.             begin
  5104.                 wind_set(DESK,WF_NEWDESK,0,0,0,0);
  5105.                 DeskRedraw
  5106.             end
  5107.     end;
  5108.  
  5109.  
  5110. procedure TApplication.LoadMenu(Indx: integer);
  5111.     var tp: PTree;
  5112.  
  5113.     begin
  5114.         tp:=GetAddr(Indx);
  5115.         if (MenuTree=nil) and (tp<>nil) and AppFlag then
  5116.             begin
  5117.                 MenuTree:=tp;
  5118.                 if MenuCorrect then
  5119.                     begin
  5120.                         if bTst(Attr.Style,as_MenuSeparator) then MenuTune;
  5121.                         if menu_bar(MenuTree,ME_DRAW)=0 then
  5122.                             begin
  5123.                                 MenuTree:=nil;
  5124.                                 Err:=em_InvalidMenu
  5125.                             end
  5126.                     end
  5127.                 else
  5128.                     begin
  5129.                         MenuTree:=nil;
  5130.                         Err:=em_InvalidMenu
  5131.                     end
  5132.             end
  5133.         else
  5134.             Err:=em_InvalidMenu
  5135.     end;
  5136.  
  5137.  
  5138. procedure TApplication.DrawMenu;
  5139.  
  5140.     begin
  5141.         if MenuTree<>nil then
  5142.             begin
  5143.                 if MultiTOS then
  5144.                     begin
  5145.                         wind_update(BEG_UPDATE);
  5146.                         if menu_bar(nil,ME_INQUIRE)=apID then menu_bar(MenuTree,ME_DRAW);
  5147.                         wind_update(END_UPDATE)
  5148.                     end
  5149.                 else
  5150.                     menu_bar(MenuTree,ME_DRAW)
  5151.             end
  5152.     end;
  5153.  
  5154.  
  5155. procedure TApplication.FreeMenu;
  5156.  
  5157.     begin
  5158.         if MenuTree<>nil then
  5159.             if menu_bar(nil,ME_ERASE)<>0 then MenuTree:=nil
  5160.     end;
  5161.  
  5162.  
  5163. function TApplication.AutoFolder: boolean;
  5164.  
  5165.     begin
  5166.         AutoFolder:=false
  5167.     end;
  5168.  
  5169.  
  5170. procedure TApplication.InitGEM;
  5171.     label _notempty;
  5172.  
  5173.   var i         : integer;
  5174.       scmd,stail: string;
  5175.       penv,dummy: pointer;
  5176.  
  5177.   begin
  5178.       GEM_pb.global[0]:=0;
  5179.       apID:=appl_init;
  5180.       if GEM_pb.global[0]=0 then
  5181.           begin
  5182.               if not(AutoFolder) then
  5183.                   begin
  5184.                       if (Attr.Country=FRG) or (Attr.Country=SWG) then
  5185.                           writeln(#27'p'+Name^+#27'q: AES nicht aktiv -> Abbruch!')
  5186.                       else
  5187.                           writeln(#27'p'+Name^+#27'q: AES not active -> quit!')
  5188.                   end;
  5189.               apID:=-1;
  5190.               Status:=em_AESNotActive;
  5191.               Err:=Status;
  5192.               exit
  5193.           end;
  5194.       if apID>=0 then
  5195.       begin
  5196.           i:=shel_read(scmd,stail);
  5197.           if AppFlag then BusyMouse;
  5198.             MultiTOS:=(GEMVersion>=$0400) and (GEM_pb.global[1]<>1);
  5199.                 if MiNTActive or MultiTOS then
  5200.                     begin
  5201.                         Psignal(SIGTERM,@SigHandler);
  5202.                         Psignal(SIGQUIT,@SigHandler)
  5203.                     end;
  5204.           if i<>0 then
  5205.               begin
  5206.                   if paramcount>0 then
  5207.                       if length(StrPTrimF(paramstr(0)))<>0 then goto _notempty;
  5208.                   StrPTrim(scmd);
  5209.                         stail:=StrPTrimF(copy(stail,2,Min(ord(stail[1]),125)))
  5210.               end
  5211.           else
  5212.               begin
  5213.                   _notempty:
  5214.                   scmd:='';
  5215.                   stail:=''
  5216.               end;
  5217.           if length(scmd)=0 then
  5218.               if paramcount>0 then
  5219.                   if length(StrPTrimF(paramstr(0)))>0 then scmd:=StrPTrimF(paramstr(0));
  5220.           if length(stail)=0 then
  5221.               begin
  5222.                   if paramcount>0 then
  5223.                       begin
  5224.                           i:=1;
  5225.                           repeat
  5226.                               if length(stail)+length(paramstr(i))>=254 then i:=paramcount
  5227.                               else
  5228.                                   stail:=stail+paramstr(i)+' ';
  5229.                               inc(i)
  5230.                           until (i>=paramcount)
  5231.                       end
  5232.                   else
  5233.                       if AppFlag then
  5234.                           if PByte(longint(BasePage)+$80)^>0 then
  5235.                               stail:=StrLPas(pointer(longint(BasePage)+$81),Min(PByte(longint(BasePage)+$80)^,125));
  5236.                   StrPTrim(stail)
  5237.               end;
  5238.                 if StrPLeft(scmd,1)='\' then
  5239.                     begin
  5240.                         if AppFlag then scmd:=chr(dgetdrv+65)+':'+scmd
  5241.                         else
  5242.                             scmd:=BootDevice+':'+scmd
  5243.                     end;
  5244.                 if StrPRight(StrPLeft(scmd,2),1)<>':' then
  5245.                     begin
  5246.                          if AppFlag then scmd:=chr(dgetdrv+65)+':\'+scmd
  5247.                          else
  5248.                              scmd:=BootDevice+':\'+scmd
  5249.                     end;
  5250.                 Attr.rpCmd:=NewStr(scmd);
  5251.                 if length(stail)>0 then Attr.rpTail:=NewStr(stail);
  5252.             aesHandle:=graf_handle(Attr.charSWidth,Attr.charSHeight,Attr.boxSWidth,Attr.boxSHeight);
  5253.             for i:=0 to 9 do workIn[i]:=1;
  5254.             workIn[10]:=RC;
  5255.             vdiHandle:=aesHandle;
  5256.             v_opnvwk(workIn,vdiHandle,workOut);
  5257.             if vdiHandle<=0 then
  5258.               begin
  5259.                   if AppFlag or MultiTOS then
  5260.                       begin
  5261.                           appl_exit;
  5262.                           apID:=-1;
  5263.                           Status:=em_GEMInitFailure;
  5264.                           Err:=Status
  5265.                       end
  5266.                   else
  5267.                       while true do evnt_timer(0,1)
  5268.                 end
  5269.               else
  5270.                   begin
  5271.                         Status:=em_OK;
  5272.                         menuID:=-1;
  5273.                         if not(AppFlag) or MultiTOS then
  5274.                             begin
  5275.                                 menuID:=menu_register(apID,'  '+StrPLeft(Name^,17)+' ');
  5276.                                 if (menuID<0) and not(AppFlag) then
  5277.                                     begin
  5278.                                         Status:=em_AccInitFailure;
  5279.                                         Err:=Status
  5280.                                     end
  5281.                             end
  5282.                     end
  5283.             end
  5284.       else
  5285.           begin
  5286.                Status:=em_GEMInitFailure;
  5287.                Err:=Status
  5288.            end
  5289.   end;
  5290.  
  5291.  
  5292. procedure    TApplication.ExitGEM;
  5293.  
  5294.   begin
  5295.       if apID>=0 then
  5296.           begin
  5297.                 RemoveDesktop;
  5298.                 FreeMenu;
  5299.                 FreeResource
  5300.           end;
  5301.       if vdiHandle>0 then
  5302.           begin
  5303.                 if bTst(Attr.Style,as_LoadFonts) then
  5304.                     if GDOSActive then vst_unload_fonts(vdiHandle,0);
  5305.               v_clsvwk(vdiHandle);
  5306.               vdiHandle:=-1
  5307.             end;
  5308.       if apID>=0 then
  5309.           begin
  5310.                 appl_exit;
  5311.                 apID:=-1
  5312.             end
  5313.     end;
  5314.  
  5315.  
  5316. procedure TApplication.SetupVDI;
  5317.     var dummy: string[33];
  5318.  
  5319.     begin
  5320.         spderr:=0;
  5321.         if GDOSActive then
  5322.             if bTst(Attr.Style,as_LoadFonts) then Attr.addFonts:=vst_load_fonts(vdiHandle,0);
  5323.         if spderr<>0 then Err:=em_SpeedoLoadFailure;
  5324.         vsl_udsty(vdiHandle,$5555);
  5325.         vsm_height(vdiHandle,1);
  5326.         vst_font(vdiHandle,vqt_name(vdiHandle,1,dummy));
  5327.         vst_height(vdiHandle,SysInfo.SFHeight,GP.charWidth,GP.charHeight,GP.boxWidth,GP.boxHeight);
  5328.         vst_alignment(vdiHandle,TA_LEFT,TA_BASELINE,GP.horAlign,GP.verAlign);
  5329.         vsf_interior(vdiHandle,FIS_HOLLOW);
  5330.         vsf_style(vdiHandle,0);
  5331.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  5332.         GP.trotation:=0;
  5333.         GP.fperimeter:=PER_ON;
  5334.         GP.teffects:=TF_NORMAL;
  5335.         GP.wrmode:=MD_REPLACE;
  5336.         GP.lendsb:=LE_SQUARED;
  5337.         GP.lendse:=LE_SQUARED;
  5338.         GP.ltype:=LT_SOLID;
  5339.         GP.mtype:=MT_DOT;
  5340.         GP.lcolor:=Black;
  5341.         GP.mcolor:=Black;
  5342.         GP.tcolor:=Black;
  5343.         GP.fcolor:=Black;
  5344.         GP.lwidth:=1
  5345.     end;
  5346.  
  5347.  
  5348. procedure TApplication.InitApplication;
  5349.  
  5350.   begin
  5351.     FirstInstance:=true;
  5352.     if Attr.Instance=$42 then
  5353.         begin
  5354.             if NewCookie(ID,getcval+1) then Attr.Instance:=1
  5355.             else
  5356.                 Attr.Instance:=0
  5357.         end
  5358.   end;
  5359.  
  5360.  
  5361. procedure TApplication.InitInstance;
  5362.  
  5363.   begin
  5364.         if Status>=em_OK then
  5365.             begin
  5366.                 if (AppFlag or MultiTOS) then pquit:=new(PQKey,Init(@self,K_CTRL,Ctrl_Q,-1,-1));
  5367.                 if bTst(Attr.Style,as_HandleShutdown) then
  5368.                     if MultiTOS then shel_write(9,0,1,'','');
  5369.                 InitMainWindow
  5370.             end
  5371.   end;
  5372.  
  5373.  
  5374. procedure TApplication.InitMainWindow;
  5375.  
  5376.     begin
  5377.         new(PWindow,Init(nil,Name^));
  5378.         if (MainWindow=nil) or (Err<em_OK) then Status:=em_InvalidMainWindow
  5379.     end;
  5380.  
  5381.  
  5382. function TApplication.GetCurrInstance: integer;
  5383.     var ret: longint;
  5384.  
  5385.     begin
  5386.         ret:=0;
  5387.         if Attr.Instance>0 then
  5388.             if GetCookie(ID,ret) then ret:=(ret and $ff);
  5389.         GetCurrInstance:=ret
  5390.     end;
  5391.  
  5392.  
  5393. function TApplication.GetGPWindow(gHnd: integer): PWindow;
  5394.     var p,pc,pc2: PWindow;
  5395.  
  5396.     begin
  5397.         GetGPWindow:=nil;
  5398.         if gHnd<0 then exit;
  5399.         p:=MainWindow;
  5400.         while (p<>nil) do
  5401.             begin
  5402.                 with p^ do
  5403.                     begin
  5404.                         if Attr.gemHandle=gHnd then
  5405.                             begin
  5406.                                 GetGPWindow:=p;
  5407.                                 exit
  5408.                             end;
  5409.                         pc:=ChildList
  5410.                     end;
  5411.                 if (pc<>nil) then
  5412.                     begin
  5413.                         while (pc^.ChildList<>nil) do pc:=pc^.ChildList;
  5414.                         repeat
  5415.                             pc2:=pc;
  5416.                             while (pc2<>nil) do
  5417.                                 with pc2^ do
  5418.                                     begin
  5419.                                         if Attr.gemHandle=gHnd then
  5420.                                             begin
  5421.                                                 GetGPWindow:=pc2;
  5422.                                                 exit
  5423.                                             end;
  5424.                                         pc2:=Nxt
  5425.                                     end;
  5426.                             pc:=pc^.Parent
  5427.                         until pc=p
  5428.                     end;
  5429.                 p:=p^.Nxt
  5430.             end
  5431.     end;
  5432.  
  5433.  
  5434. function TApplication.GetPWindow(Hnd: HWnd): PWindow;
  5435.     var p,pc,pc2: PWindow;
  5436.  
  5437.     begin
  5438.         p:=MainWindow;
  5439.         while (p<>nil) do
  5440.             begin
  5441.                 with p^ do
  5442.                     begin
  5443.                         if Attr.Handle=Hnd then
  5444.                             begin
  5445.                                 GetPWindow:=p;
  5446.                                 exit
  5447.                             end;
  5448.                         pc:=ChildList
  5449.                     end;
  5450.                 if (pc<>nil) then
  5451.                     begin
  5452.                         while (pc^.ChildList<>nil) do pc:=pc^.ChildList;
  5453.                         repeat
  5454.                             pc2:=pc;
  5455.                             while (pc2<>nil) do
  5456.                                 with pc2^ do
  5457.                                     begin
  5458.                                         if Attr.Handle=Hnd then
  5459.                                             begin
  5460.                                                 GetPWindow:=pc2;
  5461.                                                 exit
  5462.                                             end;
  5463.                                         pc2:=Nxt
  5464.                                     end;
  5465.                             pc:=pc^.Parent
  5466.                         until pc=p
  5467.                     end;
  5468.                 p:=p^.Nxt
  5469.             end;
  5470.         GetPWindow:=nil
  5471.     end;
  5472.  
  5473.  
  5474. function TApplication.GetPTopWindow: PWindow;
  5475.     var top,dummy: integer;
  5476.  
  5477.     begin
  5478.         wind_get(DESK,WF_TOP,top,dummy,dummy,dummy);
  5479.         GetPTopWindow:=GetGPWindow(top)
  5480.     end;
  5481.  
  5482.  
  5483. function TApplication.GetMsTimer: longint;
  5484.  
  5485.     begin
  5486.         GetMsTimer:=1000
  5487.     end;
  5488.  
  5489.  
  5490. procedure TApplication.GetCrsRect(var crect: GRECT);
  5491.  
  5492.     begin
  5493.         if pcrswatch<>nil then crect:=pcrswatch^.Work
  5494.     end;
  5495.  
  5496.  
  5497. function TApplication.GetEvent(var data: TEventData): integer;
  5498.     var crect: GRECT;
  5499.  
  5500.     begin
  5501.         GetCrsRect(crect);
  5502.         GetEvent:=evnt_multi(Attr.EventMask,258,3,0,0,crect.X,crect.Y,crect.W,crect.H,
  5503.                                                  1,crect.X,crect.Y,crect.W,crect.H,data.Pipe,GetMsTimer mod 65536,
  5504.                                                  GetMsTimer div 65536,data.mX,data.mY,data.BStat,data.KStat,data.Key,data.Clicks)
  5505.     end;
  5506.  
  5507.  
  5508. procedure TApplication.MessageLoop;
  5509.     var data : TEventData;
  5510.             event: integer;
  5511.  
  5512.   begin
  5513.       repeat
  5514.           Status:=em_OK;
  5515.             while (Status>=em_OK) do
  5516.                 begin
  5517.                   event:=GetEvent(data);
  5518.                     if bTst(event,MU_KEYBD) then MUKeybd(data);
  5519.                     if bTst(event,MU_BUTTON) then MUButton(data);
  5520.                     if bTst(event,MU_M1) then MUM1(data);
  5521.                     if bTst(event,MU_M2) then MUM2(data);
  5522.                     if bTst(event,MU_MESAG) then MUMesag(data);
  5523.                     if bTst(event,MU_TIMER) then MUTimer(data)
  5524.                 end;
  5525.             if Status=em_Terminate then break;
  5526.             HandleError;
  5527.             if Status>=em_OK then continue
  5528.         until (Status<>em_Quit) or CanClose
  5529.   end;
  5530.  
  5531.  
  5532. procedure TApplication.MUKeybd(data: TEventData);
  5533.     var p         : PEvent;
  5534.         pw        : PWindow;
  5535.         found     : boolean;
  5536.  
  5537.     begin
  5538.         found:=false;
  5539.         if not(allicn) then
  5540.             begin
  5541.                 pw:=GetPTopWindow;
  5542.                 if pw<>nil then
  5543.                     if not(pw^.IsIconified) then
  5544.                         begin
  5545.                             p:=pw^.EventList;
  5546.                             while (p<>nil) and not(found) do
  5547.                                 with p^ do
  5548.                                     begin
  5549.                                         found:=TestKey(data.KStat,data.Key);
  5550.                                         p:=Nxt
  5551.                                     end
  5552.                         end
  5553.             end;
  5554.         if not(found) then
  5555.             begin
  5556.                 p:=EventList;
  5557.                 while (p<>nil) and not(found) do
  5558.                     with p^ do
  5559.                         begin
  5560.                             found:=TestKey(data.KStat,data.Key);
  5561.                             p:=Nxt
  5562.                         end
  5563.             end;
  5564.         if not(found) then HandleKeybd(data.KStat,data.Key)
  5565.     end;
  5566.  
  5567.  
  5568. procedure TApplication.MUButton(data: TEventData);
  5569.     label _desktop,_weiter,_handle;
  5570.  
  5571.     var p                 : PEvent;
  5572.         pw                : PWindow;
  5573.         found             : boolean;
  5574.         r                 : GRECT;
  5575.         top,dummy,offen,
  5576.         aespid,drunter,tbi,
  5577.         rx,ry,rw,rh       : integer;
  5578.  
  5579.     begin
  5580.         found:=false;
  5581.         p:=EventList;
  5582.         while (p<>nil) and not(found) do
  5583.             with p^ do
  5584.                 begin
  5585.                     found:=TestButton(data.mX,data.mY,data.BStat,data.KStat,data.Clicks);
  5586.                     p:=Nxt
  5587.                 end;
  5588.         if not(found) and not(allicn) then
  5589.             begin
  5590.                 pw:=GetPTopWindow;
  5591.                 if pw<>nil then
  5592.                     begin
  5593.                         if not(pw^.IsIconified) then
  5594.                             begin
  5595.                                 p:=pw^.EventList;
  5596.                                 while (p<>nil) and not(found) do
  5597.                                     with p^ do
  5598.                                         begin
  5599.                                             found:=TestButton(data.mX,data.mY,data.BStat,data.KStat,data.Clicks);
  5600.                                             p:=Nxt
  5601.                                         end
  5602.                             end
  5603.                         else
  5604.                             if pw^.icfpos>=0 then
  5605.                                 if Between(data.mX,pw^.Work.X1,pw^.Work.X2) and Between(data.mY,pw^.Work.Y1,pw^.Work.Y2) then
  5606.                                     begin
  5607.                                         with pw^.icfcurr do pw^.WMUniconify(X,Y,W,H);
  5608.                                         found:=true
  5609.                                     end
  5610.                     end
  5611.             end;
  5612.         if not(found) then
  5613.             begin
  5614.                 pw:=nil;
  5615.                 if not(allicn) then
  5616.                     begin
  5617.                         if GEMVersion<$0400 then pw:=GetPTopWindow
  5618.                         else
  5619.                             begin
  5620.                                 wind_get(DESK,WF_TOP,top,dummy,dummy,dummy);
  5621.                                 while top>DESK do
  5622.                                     begin
  5623.                                         wind_get(top,WF_OWNER,aespid,offen,dummy,drunter);
  5624.                                         if (aespid=apID) and (offen=1) then
  5625.                                             begin
  5626.                                                 pw:=GetGPWindow(top);
  5627.                                                 if pw<>nil then
  5628.                                                     with pw^ do
  5629.                                                         begin
  5630.                                                             wind_get(Attr.gemHandle,WF_WORKXYWH,rx,ry,rw,rh);
  5631.                                                             if (data.mX>=rx) and (data.mX<rx+rw) and (data.mY>=ry) and (data.mY<ry+rh) then
  5632.                                                                 goto _weiter
  5633.                                                             else
  5634.                                                                 pw:=nil
  5635.                                                         end
  5636.                                             end;
  5637.                                         top:=drunter
  5638.                                     end
  5639.                             end
  5640.                     end;
  5641.                 _weiter:
  5642.                 if pw<>nil then
  5643.                     with pw^ do
  5644.                         if IsIconified then goto _handle
  5645.                         else
  5646.                             begin
  5647.                                 GRtoA2(Work);
  5648.                                 if (data.mX>=Work.X1) and (data.mX<=Work.X2) and (data.mY>=Work.Y1) and (data.mY<=Work.Y2) then
  5649.                                     WMButton(data.mX,data.mY,data.BStat,data.KStat,data.Clicks)
  5650.                                 else
  5651.                                     if Class.ToolbarTree<>nil then
  5652.                                         begin
  5653.                                             wind_get(Attr.gemHandle,WF_WORKXYWH,rx,ry,rw,rh);
  5654.                                             if (data.mX>=rx) and (data.mX<rx+rw) and (data.mY>=ry) and (data.mY<ry+rh) then
  5655.                                                 begin
  5656.                                                     tbi:=objc_find(Class.ToolbarTree,ROOT,MAX_DEPTH,data.mX,data.mY);
  5657.                                                     if tbi>0 then WMToolbar(tbi,data.BStat,data.KStat,data.Clicks)
  5658.                                                 end
  5659.                                             else
  5660.                                                 goto _desktop
  5661.                                         end
  5662.                                     else
  5663.                                         goto _desktop
  5664.                             end
  5665.                 else
  5666.                     begin
  5667.                         _desktop:
  5668.                         if (data.BStat=1) and (data.Clicks=1) and bTst(Attr.Style,as_Rubbox) then
  5669.                             begin
  5670.                                 if (data.mX>=DRect.X1) and (data.mX<=DRect.X2) and (data.mY>=DRect.Y1) and (data.mY<=DRect.Y2) then
  5671.                                     if Rubbox(DESK,data.mX,data.mY,DRect.X1,DRect.Y1,DRect.X2,DRect.Y2,r) then MURubbox(r)
  5672.                             end
  5673.                         else
  5674.                             _handle:
  5675.                             HandleButton(data.mX,data.mY,data.BStat,data.KStat,data.Clicks)
  5676.                     end
  5677.             end
  5678.     end;
  5679.  
  5680.  
  5681. procedure TApplication.MURubbox(r: GRECT);
  5682.  
  5683.     begin
  5684.     end;
  5685.  
  5686.  
  5687. procedure TApplication.MURBoxChanged(r: GRECT);
  5688.  
  5689.     begin
  5690.     end;
  5691.  
  5692.  
  5693. procedure TApplication.MUM1(data: TEventData);
  5694.     var p         : PEvent;
  5695.         pw        : PWindow;
  5696.         found     : boolean;
  5697.  
  5698.     begin
  5699.         found:=false;
  5700.         p:=EventList;
  5701.         while (p<>nil) and not(found) do
  5702.             with p^ do
  5703.                 begin
  5704.                     found:=TestMouse(MU_M1,data.mX,data.mY,data.BStat,data.KStat);
  5705.                     p:=Nxt
  5706.                 end;
  5707.         if not(found) and not(allicn) then
  5708.             begin
  5709.                 pw:=GetPTopWindow;
  5710.                 if pw<>nil then
  5711.                     if not(pw^.IsIconified) then
  5712.                         begin
  5713.                             p:=pw^.EventList;
  5714.                             while (p<>nil) and not(found) do
  5715.                                 with p^ do
  5716.                                     begin
  5717.                                         found:=TestMouse(MU_M1,data.mX,data.mY,data.BStat,data.KStat);
  5718.                                         p:=Nxt
  5719.                                     end
  5720.                         end
  5721.             end;
  5722.         if not(found) then HandleM1(data.mX,data.mY,data.BStat,data.KStat)
  5723.     end;
  5724.     
  5725.     
  5726. procedure TApplication.MUM2(data: TEventData);
  5727.     var p         : PEvent;
  5728.         pw        : PWindow;
  5729.         found     : boolean;
  5730.  
  5731.     begin
  5732.         found:=false;
  5733.         p:=EventList;
  5734.         while (p<>nil) and not(found) do
  5735.             with p^ do
  5736.                 begin
  5737.                     found:=TestMouse(MU_M2,data.mX,data.mY,data.BStat,data.KStat);
  5738.                     p:=Nxt
  5739.                 end;
  5740.         if not(found) and not(allicn) then
  5741.             begin
  5742.                 pw:=GetPTopWindow;
  5743.                 if pw<>nil then
  5744.                     if not(pw^.IsIconified) then
  5745.                         begin
  5746.                             p:=pw^.EventList;
  5747.                             while (p<>nil) and not(found) do
  5748.                                 with p^ do
  5749.                                     begin
  5750.                                         found:=TestMouse(MU_M2,data.mX,data.mY,data.BStat,data.KStat);
  5751.                                         p:=Nxt
  5752.                                     end
  5753.                         end
  5754.             end;
  5755.         if not(found) then HandleM2(data.mX,data.mY,data.BStat,data.KStat)
  5756.     end;
  5757.  
  5758.  
  5759. procedure TApplication.MUMesag(data: TEventData);
  5760.     var p,pw        : PWindow;
  5761.         pg          : PEvent;
  5762.         found       : boolean;
  5763.         ret,dummy,ks: integer;
  5764.             ICFGetPos   : function(d1,d2: pointer; d3,d4,d5: longint; fn: integer; px,py,pw,ph: pointer): integer;
  5765.  
  5766.     procedure shwr_ap_tfail(err: integer);
  5767.         var pipe: Pipearray;
  5768.  
  5769.         begin
  5770.             pipe[0]:=AP_TFAIL;
  5771.             pipe[1]:=err;
  5772.             with AES_pb do
  5773.                 begin
  5774.                     control^[0]:=121;
  5775.                     control^[1]:=3;
  5776.                     control^[3]:=2;
  5777.                     intin^[0]:=10;
  5778.                     intin^[1]:=0;
  5779.                     intin^[2]:=0;
  5780.                     addrin^[0]:=@pipe;
  5781.                     addrin^[1]:=nil
  5782.                 end;
  5783.             _crystal(@AES_pb)
  5784.         end;
  5785.  
  5786.     procedure xaccreply(used: boolean);
  5787.         var pipe: Pipearray;
  5788.  
  5789.         begin
  5790.             pipe[0]:=ACC_ACK;
  5791.             pipe[1]:=apID;
  5792.             pipe[2]:=0;
  5793.             if used then pipe[3]:=1
  5794.             else
  5795.                 pipe[3]:=0;
  5796.             appl_write(data.Pipe[1],16,@pipe)
  5797.         end;
  5798.  
  5799.     begin
  5800.         wind_update(BEG_UPDATE);
  5801.         if MessageBuffer<>nil then
  5802.             begin
  5803.                 freemem(MessageBuffer,MessageBLen);
  5804.                 MessageBuffer:=nil
  5805.             end;
  5806.         MessageBLen:=data.Pipe[2];
  5807.         if MessageBLen>0 then
  5808.             begin
  5809.                 if data.Pipe[0]<>24 then getmem(MessageBuffer,MessageBLen);
  5810.                 if MessageBuffer<>nil then appl_read(apID,MessageBLen,MessageBuffer)
  5811.                 else
  5812.                     MessageBLen:=0
  5813.             end;
  5814.         case data.Pipe[0] of
  5815.             MN_SELECTED: if GEMVersion>=$0330 then
  5816.                                          MNSelected(data.Pipe[4],data.Pipe[3],Ptr(word(data.Pipe[5]),word(data.Pipe[6])),data.Pipe[7])
  5817.                                      else
  5818.                                           MNSelected(data.Pipe[4],data.Pipe[3],nil,0);
  5819.             WM_REDRAW: begin
  5820.                                      p:=GetGPWindow(data.Pipe[3]);
  5821.                                      if p<>nil then p^.WMRedraw(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  5822.                                  end;
  5823.             WM_TOPPED: begin
  5824.                                      p:=GetGPWindow(data.Pipe[3]);
  5825.                                      if p<>nil then p^.WMTopped
  5826.                                  end;
  5827.             WM_CLOSED: begin
  5828.                                      graf_mkstate(dummy,dummy,dummy,ks);
  5829.                                      p:=GetGPWindow(data.Pipe[3]);
  5830.                                      if p<>nil then
  5831.                                        begin
  5832.                                              if (ks and (K_RSHIFT+K_LSHIFT+K_ALT))<>0 then
  5833.                                                  begin
  5834.                                                      if bTst(ks,K_ALT) and (icfserver<>nil) and not(p^.IsIconified) then
  5835.                                                        begin
  5836.                                                             ICFGetPos:=icfserver;
  5837.                                                            p^.icfpos:=ICFGetPos(nil,nil,0,0,0,ICF_GETPOS,@data.Pipe[4],@data.Pipe[5],@data.Pipe[6],@data.Pipe[7]);
  5838.                                                            if p^.icfpos>=0 then
  5839.                                                              begin
  5840.                                                                p^.GetCurr;
  5841.                                                                p^.icfcurr:=p^.Curr;
  5842.                                                                      p^.WMIconify(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  5843.                                                                  end
  5844.                                                          end
  5845.                                                  end
  5846.                                              else
  5847.                                                p^.WMClosed
  5848.                                          end
  5849.                                  end;
  5850.             WM_FULLED: begin
  5851.                                      p:=GetGPWindow(data.Pipe[3]);
  5852.                                      if p<>nil then p^.WMFulled
  5853.                                  end;
  5854.             WM_ARROWED: begin
  5855.                                         p:=GetGPWindow(data.Pipe[3]);
  5856.                                         if p<>nil then p^.WMArrowed(data.Pipe[4])
  5857.                                     end;
  5858.             WM_HSLID: begin
  5859.                                     p:=GetGPWindow(data.Pipe[3]);
  5860.                                     if p<>nil then p^.WMHSlid(data.Pipe[4])
  5861.                                 end;
  5862.             WM_VSLID: begin
  5863.                                     p:=GetGPWindow(data.Pipe[3]);
  5864.                                     if p<>nil then p^.WMVSlid(data.Pipe[4])
  5865.                                 end;
  5866.             WM_SIZED: begin
  5867.                                     p:=GetGPWindow(data.Pipe[3]);
  5868.                                     if p<>nil then p^.WMSized(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  5869.                                 end;
  5870.             WM_MOVED: begin
  5871.                                     p:=GetGPWindow(data.Pipe[3]);
  5872.                                     if p<>nil then p^.WMMoved(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  5873.                                 end;
  5874.             WM_NEWTOP: begin
  5875.                                      p:=GetGPWindow(data.Pipe[3]);
  5876.                                      if p<>nil then p^.WMNewTop
  5877.                                  end;
  5878.             WM_UNTOPPED: begin
  5879.                                          p:=GetGPWindow(data.Pipe[3]);
  5880.                                          if p<>nil then p^.WMUntopped
  5881.                                      end;
  5882.             WM_ONTOP: begin
  5883.                                     p:=GetGPWindow(data.Pipe[3]);
  5884.                                     if p<>nil then p^.WMOnTop
  5885.                                 end;
  5886.             WM_BOTTOMED: begin
  5887.                                          p:=GetGPWindow(data.Pipe[3]);
  5888.                                          if p<>nil then p^.WMBottomed
  5889.                                      end;
  5890.             WM_ICONIFY: begin
  5891.                                         p:=GetGPWindow(data.Pipe[3]);
  5892.                                         if p<>nil then
  5893.                                             if not(p^.IsIconified) then
  5894.                                                 p^.WMIconify(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  5895.                                     end;
  5896.             WM_UNICONIFY: if allicn then
  5897.                                             begin
  5898.                                                 allicn:=false;
  5899.                                                 ForEachWnd(@IconifyFadein);
  5900.                                                 dispose(icnwnd,Done)
  5901.                                             end
  5902.                                         else
  5903.                                             begin
  5904.                                                 p:=GetGPWindow(data.Pipe[3]);
  5905.                                                 if p<>nil then p^.WMUniconify(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  5906.                                             end;
  5907.             WM_ALLICONIFY: begin
  5908.                                              icnwnd:=new(PIcnWnd,Init(nil,StrPLeft(StrPTrimF(GetIconTitle),10),data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7]));
  5909.                                              allicn:=true;
  5910.                                              ForEachWnd(@IconifyFadeout)
  5911.                                          end;
  5912.             AC_OPEN: ACOpen(data.Pipe[4]);
  5913.             AC_CLOSE: if MultiTOS then
  5914.                                     begin
  5915.                                         ret:=ACClose(data.Pipe[3],data.Pipe[5]);
  5916.                                         if ret<>em_OK then shwr_ap_tfail(ret)
  5917.                                     end
  5918.                                 else
  5919.                                     ACClose(data.Pipe[3],AC_CLOSE);
  5920.             AP_TERM: begin
  5921.                                  ret:=APTerm(data.Pipe[5]);
  5922.                                  if ret<>em_OK then shwr_ap_tfail(ret)
  5923.                                  else
  5924.                                      Status:=em_Terminate
  5925.                              end;
  5926.             AP_DRAGDROP: APDragDrop(data.Pipe[7],data.Pipe[1],data.Pipe[3],data.Pipe[4],data.Pipe[5],data.Pipe[6]);
  5927.             SHUT_COMPLETED: ShutCompleted(data.Pipe[3],data.Pipe[4],data.Pipe[5]);
  5928.             RESCH_COMPLETED: ResChCompleted(data.Pipe[3]);
  5929.             CH_EXIT: CHExit(data.Pipe[3],data.Pipe[4]);
  5930.             SH_WDRAW: SHWDraw(data.Pipe[3]);
  5931.             CB_UPDATE: CBUpdate(data.Pipe[1],word(data.Pipe[3]),chr((word(data.Pipe[4]) shr 8) and $00ff)+chr(data.Pipe[4] and $00ff)+chr((word(data.Pipe[5]) shr 8) and $00ff)+chr(data.Pipe[5] and $00ff));
  5932.             ACC_ID: XAccID(data.Pipe[1],data.Pipe[6],byte(data.Pipe[3] and $00ff),byte((data.Pipe[3] and $ff00) shr 8),Ptr(word(data.Pipe[4]),word(data.Pipe[5])));
  5933.             ACC_ACC: if MultiTOS then XAccAcc(data.Pipe[1],data.Pipe[6],byte(data.Pipe[3] and $00ff),byte((data.Pipe[3] and $ff00) shr 8),Ptr(word(data.Pipe[4]),word(data.Pipe[5])))
  5934.                      else
  5935.                        XAccAcc(data.Pipe[7],data.Pipe[6],byte(data.Pipe[3] and $00ff),byte((data.Pipe[3] and $ff00) shr 8),Ptr(word(data.Pipe[4]),word(data.Pipe[5])));
  5936.             ACC_EXIT: XAccExit(data.Pipe[1]);
  5937.             ACC_TEXT: xaccreply(XAccText(data.Pipe[1],Ptr(word(data.Pipe[4]),word(data.Pipe[5]))));
  5938.             ACC_KEY: xaccreply(XAccKey(data.Pipe[1],data.Pipe[4],data.Pipe[3]));
  5939.             ACC_META: xaccreply(XAccMeta(data.Pipe[1],Ptr(word(data.Pipe[4]),word(data.Pipe[5])),longint(Ptr(word(data.Pipe[6]),word(data.Pipe[7]))),data.Pipe[3]=1));
  5940.             ACC_IMG: xaccreply(XAccIMG(data.Pipe[1],Ptr(word(data.Pipe[4]),word(data.Pipe[5])),longint(Ptr(word(data.Pipe[6]),word(data.Pipe[7]))),data.Pipe[3]=1));
  5941.             ACC_OPEN,ACC_CLOSE,ACC_ACK: HandleXAcc(data.Pipe);
  5942.             AV_PROTOKOLL: AVProtokoll(data.Pipe[1],data.Pipe[3],StrPas(Ptr(word(data.Pipe[6]),word(data.Pipe[7]))));
  5943.             VA_PROTOSTATUS: VAProtoStatus(data.Pipe[1],data.Pipe[3],StrPas(Ptr(word(data.Pipe[6]),word(data.Pipe[7]))));
  5944.             AV_EXIT: AVExit(data.Pipe[3]);
  5945.             AV_GETSTATUS..AV_DRAG_ON_WINDOW: HandleAV(data.Pipe)
  5946.         else
  5947.             begin
  5948.                 found:=false;
  5949.                 pg:=EventList;
  5950.                 while (pg<>nil) and not(found) do
  5951.                     with pg^ do
  5952.                         begin
  5953.                             found:=TestMessage(data.Pipe);
  5954.                             pg:=Nxt
  5955.                         end;
  5956.                 if not(found) and not(allicn) then
  5957.                     begin
  5958.                         pw:=GetPTopWindow;
  5959.                         if pw<>nil then
  5960.                             begin
  5961.                                 pg:=pw^.EventList;
  5962.                                 while (pg<>nil) and not(found) do
  5963.                                     with pg^ do
  5964.                                         begin
  5965.                                             found:=TestMessage(data.Pipe);
  5966.                                             pg:=Nxt
  5967.                                         end
  5968.                             end
  5969.                     end;
  5970.                 if not(found) then HandleMesag(data.Pipe)
  5971.             end
  5972.         end;
  5973.         wind_update(END_UPDATE)
  5974.     end;
  5975.  
  5976.  
  5977. procedure TApplication.MUTimer(data: TEventData);
  5978.  
  5979.     begin
  5980.         HandleTimer
  5981.     end;
  5982.  
  5983.  
  5984. procedure TApplication.MNSelected(meNum,mtNum: integer; Tree: PTree; PrIndx: integer);
  5985.     var p         : PEvent;
  5986.         pw        : PWindow;
  5987.         found     : boolean;
  5988.  
  5989.     begin
  5990.         menu_tnormal(MenuTree,mtNum,ME_INVERT);
  5991.         found:=false;
  5992.         p:=EventList;
  5993.         while (p<>nil) and not(found) do
  5994.             with p^ do
  5995.                 begin
  5996.                     found:=TestMenu(meNum);
  5997.                     p:=Nxt
  5998.                 end;
  5999.         if not(found) then
  6000.             begin
  6001.                 pw:=GetPTopWindow;
  6002.                 if pw<>nil then
  6003.                     begin
  6004.                         p:=pw^.EventList;
  6005.                         while (p<>nil) and not(found) do
  6006.                             with p^ do
  6007.                                 begin
  6008.                                     found:=TestMenu(meNum);
  6009.                                     p:=Nxt
  6010.                                 end
  6011.                     end
  6012.             end;
  6013.         if not(found) then HandleMenu(meNum);
  6014.         menu_tnormal(MenuTree,mtNum,ME_NORMAL)
  6015.     end;
  6016.  
  6017.  
  6018. procedure TApplication.ACOpen(mID: integer);
  6019.     var p: PWindow;
  6020.  
  6021.     begin
  6022.         if mID=menuID then
  6023.             begin
  6024.                 ChkError;
  6025.                 p:=MainWindow;
  6026.                 while (p<>nil) do
  6027.                     with p^ do
  6028.                         begin
  6029.                             if bTst(Class.Style,cs_CreateOnAccOpen) then Create;
  6030.                             OpenWindow;
  6031.                             if IsDialog then
  6032.                                 if (PDialog(p)^.IsModal) and (Err>=em_OutOfMemory) then PDialog(p)^.Execute;
  6033.                             p:=Nxt
  6034.                         end;
  6035.                 if Err<em_OutOfMemory then Error(Err)
  6036.             end
  6037.     end;
  6038.  
  6039.  
  6040. function TApplication.ACClose(mID,Why: integer): integer;
  6041.     var p   : PWindow;
  6042.         pipe: Pipearray;
  6043.  
  6044.     begin
  6045.         if mID=menuID then
  6046.             begin
  6047.                 p:=MainWindow;
  6048.                 while (p<>nil) do
  6049.                     with p^ do
  6050.                         begin
  6051.                             RawDestroy;
  6052.                             p:=Nxt;
  6053.                         end;
  6054.                 if not(MultiTOS) then
  6055.                     begin
  6056.                         if XAccList<>nil then dispose(PXAccCollection(XAccList),Done);
  6057.                         AVServer:=id_No;
  6058.                         XAccList:=nil;
  6059.                         pipe[0]:=ACC_ID;
  6060.                         pipe[1]:=apID;
  6061.                         pipe[2]:=0;
  6062.                         pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  6063.                         pipe[4]:=integer(HiWord(xaccname));
  6064.                         pipe[5]:=integer(LoWord(xaccname));
  6065.                         pipe[6]:=menuID;
  6066.                         pipe[7]:=0;
  6067.                         appl_write(DESK,16,@pipe);
  6068.                         pipe[0]:=AV_PROTOKOLL;
  6069.                         pipe[1]:=apID;
  6070.                         pipe[2]:=0;
  6071.                         pipe[3]:=integer(XAcc.AVAccMsg);
  6072.                         pipe[4]:=0;
  6073.                         pipe[5]:=0;
  6074.                         pipe[6]:=integer((longint(apName)+1) div 65536);
  6075.                         pipe[7]:=integer((longint(apName)+1) mod 65536);
  6076.                         appl_write(DESK,16,@pipe)
  6077.                     end
  6078.             end;
  6079.         ACClose:=em_OK
  6080.     end;
  6081.  
  6082.  
  6083. function TApplication.APTerm(Why: integer): integer;
  6084.  
  6085.     begin
  6086.         APTerm:=em_OK
  6087.     end;
  6088.  
  6089.  
  6090. procedure TApplication.APDragDrop(PipeID,OrgID,WindID,mX,mY,KStat: integer);
  6091.     label _error;
  6092.  
  6093.     var ddp   : PWindow;
  6094.         oldsig: pointer;
  6095.         pname : string[19];
  6096.         res   : longint;
  6097.  
  6098.     begin
  6099.         ddokflag:=false;
  6100.         wind_update(END_UPDATE);
  6101.         ddp:=GetGPWindow(WindID);
  6102.         pname:='U:\PIPE\DRAGDROP.'+chr((PipeID and $ff00) shr 8)+chr(PipeID and $00ff);
  6103.         res:=fopen(pname,FO_RW);
  6104.         if res<0 then goto _error;
  6105.         oldsig:=Psignal(SIGPIPE,SIG_IGN);
  6106.         if ddp=nil then HandleDragDrop(integer(res),OrgID,WindID,mX,mY,KStat)
  6107.         else
  6108.             ddp^.WMDragDrop(integer(res),OrgID,mX,mY,KStat);
  6109.         if longint(oldsig)>0 then Psignal(SIGPIPE,oldsig);
  6110.         fclose(integer(res));
  6111.         _error:
  6112.         evnt_timer(1000,0);
  6113.         wind_update(BEG_UPDATE);
  6114.         if ddokflag then
  6115.             begin
  6116.                 if ddp=nil then DDFinished(OrgID,WindID,mX,mY,KStat)
  6117.                 else
  6118.                     ddp^.DDFinished(OrgID,mX,mY,KStat)
  6119.             end
  6120.     end;
  6121.  
  6122.  
  6123. procedure TApplication.ShutCompleted(Stat,ErrID,ErrCode: integer);
  6124.  
  6125.     begin
  6126.     end;
  6127.  
  6128.  
  6129. procedure TApplication.ResChCompleted(Stat: integer);
  6130.  
  6131.     begin
  6132.         if Stat=1 then Status:=em_Terminate
  6133.     end;
  6134.  
  6135.  
  6136. procedure TApplication.CHExit(ChID,ChRet: integer);
  6137.  
  6138.     begin
  6139.     end;
  6140.  
  6141.  
  6142. procedure TApplication.SHWDraw(Drive: integer);
  6143.  
  6144.     begin
  6145.     end;
  6146.  
  6147.  
  6148. procedure TApplication.CBUpdate(OrgID: integer; Bits: word; Ext: string);
  6149.  
  6150.     begin
  6151.     end;
  6152.  
  6153.  
  6154. procedure TApplication.XAccID(OrgID,mID: integer; Msg,Ver: byte; pName: PChar);
  6155.     var pipe: Pipearray;
  6156.         q   : integer;
  6157.  
  6158.     begin
  6159.         if MultiTOS then
  6160.             begin
  6161.                 XAccInsert(OrgID,mID,Msg,Ver,pName);
  6162.                 pipe[0]:=ACC_ACC;
  6163.                 pipe[1]:=apID;
  6164.                 pipe[2]:=0;
  6165.                 pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  6166.                 pipe[4]:=integer(HiWord(xaccname));
  6167.                 pipe[5]:=integer(LoWord(xaccname));
  6168.                 pipe[6]:=menuID;
  6169.                 pipe[7]:=0;
  6170.                 appl_write(OrgID,16,@pipe)
  6171.             end
  6172.         else
  6173.             if AppFlag then
  6174.                 begin
  6175.                     pipe[0]:=ACC_ID;
  6176.                     pipe[1]:=apID;
  6177.                     pipe[2]:=0;
  6178.                     pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  6179.                     pipe[4]:=integer(HiWord(xaccname));
  6180.                     pipe[5]:=integer(LoWord(xaccname));
  6181.                     pipe[6]:=-1;
  6182.                     pipe[7]:=0;
  6183.                     appl_write(OrgID,16,@pipe);
  6184.                     pipe[0]:=ACC_ACC;
  6185.                     pipe[3]:=integer((Ver shl 8)+Msg);
  6186.                     pipe[4]:=integer(HiWord(pName));
  6187.                     pipe[5]:=integer(LoWord(pName));
  6188.                     pipe[6]:=mID;
  6189.                     pipe[7]:=OrgID;
  6190.                     if XAccList<>nil then
  6191.                         with XAccList^ do
  6192.                             if Count>0 then
  6193.                                 for q:=0 to Count-1 do
  6194.                                     if At(q)<>nil then
  6195.                                         appl_write(PXAccAttr(At(q))^.apID,16,@pipe);
  6196.                     XAccInsert(OrgID,mID,Msg,Ver,pName)
  6197.                 end
  6198.             else
  6199.                 XAccInsert(OrgID,mID,Msg,Ver,pName)
  6200.     end;
  6201.  
  6202.  
  6203. procedure TApplication.XAccAcc(accID,mID: integer; Msg,Ver: byte; pName: PChar);
  6204.     var pipe: Pipearray;
  6205.  
  6206.     begin
  6207.         XAccInsert(accID,mID,Msg,Ver,pName);
  6208.         if not(MultiTOS) then
  6209.             begin
  6210.                 pipe[0]:=ACC_ID;
  6211.                 pipe[1]:=apID;
  6212.                 pipe[2]:=0;
  6213.                 pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  6214.                 pipe[4]:=integer(HiWord(xaccname));
  6215.                 pipe[5]:=integer(LoWord(xaccname));
  6216.                 pipe[6]:=menuID;
  6217.                 pipe[7]:=0;
  6218.                 appl_write(accID,16,@pipe)
  6219.             end
  6220.     end;
  6221.  
  6222.  
  6223. function TApplication.XAccInsert(accID,mID: integer; Msg,Ver: byte; pName: PChar): boolean;
  6224.     var pxattr: PXAccAttr;
  6225.         xattr : TXAccAttr;
  6226.         dummy : string;
  6227.  
  6228.     begin
  6229.         XAccInsert:=false;
  6230.         if FindApplication('',accID,xattr) then
  6231.             if bTst(xattr.Protocol,PROTO_XACC) then
  6232.                 begin
  6233.                     if xattr.menuID=mID then exit
  6234.                     else
  6235.                         lastfa:=-1
  6236.                 end;
  6237.         if XAccList=nil then XAccList:=new(PXAccCollection,Init(5,5));
  6238.         if XAccList=nil then exit;
  6239.         new(pxattr);
  6240.         if pxattr<>nil then
  6241.             begin
  6242.                 with pxattr^ do
  6243.                     begin
  6244.                         Version:=Ver;
  6245.                         MsgGroups:=Msg;
  6246.                         if lastfa<0 then
  6247.                             begin
  6248.                                 Protocol:=PROTO_XACC;
  6249.                                 AVSrvMsg:=0;
  6250.                                 AVAccMsg:=0
  6251.                             end
  6252.                         else
  6253.                             begin
  6254.                                 Protocol:=xattr.Protocol or PROTO_XACC;
  6255.                                 AVSrvMsg:=xattr.AVSrvMsg;
  6256.                                 AVAccMsg:=xattr.AVAccMsg
  6257.                             end;
  6258.                         apID:=accID;
  6259.                         menuID:=mID;
  6260.                         AppTypeMR:='';
  6261.                         AppTypeHR:=nil;
  6262.                         ExtFeatures:=nil;
  6263.                         GenericName:=nil;
  6264.                         pXDSC:=nil;
  6265.                         Name:=NewStr(StrPas(pName));
  6266.                         inc(longint(pName),length(Name^)+1);
  6267.                         if StrPas(pName)='XDSC' then
  6268.                             begin
  6269.                                 inc(longint(pName),5);
  6270.                                 pXDSC:=pName;
  6271.                                 dummy:=StrPas(pName);
  6272.                                 while length(dummy)>0 do
  6273.                                     begin
  6274.                                         case dummy[1] of
  6275.                                             '1': AppTypeHR:=NewStr(StrPRight(dummy,length(dummy)-1));
  6276.                                             '2': AppTypeMR:=StrPLeft(StrPRight(dummy,length(dummy)-1),2);
  6277.                                             'X': ExtFeatures:=NewStr(StrPRight(dummy,length(dummy)-1));
  6278.                                             'N': GenericName:=NewStr(StrPRight(dummy,length(dummy)-1))
  6279.                                         end;
  6280.                                         inc(longint(pName),length(dummy)+1);
  6281.                                         dummy:=StrPas(pName)
  6282.                                     end;
  6283.                                 if AppTypeHR=nil then AppTypeHR:=NewStr(XAccMR2HR(AppTypeMR))
  6284.                             end
  6285.                     end;
  6286.                 if lastfa>=0 then XAccList^.AtFree(lastfa);
  6287.                 XAccList^.Insert(pxattr);
  6288.                 XAccInsert:=true
  6289.             end
  6290.     end;
  6291.  
  6292.  
  6293. procedure TApplication.XAccExit(OrgID: integer);
  6294.     label _again;
  6295.  
  6296.     var q: longint;
  6297.  
  6298.     begin
  6299.         if XAccList<>nil then
  6300.             with XAccList^ do
  6301.                 begin
  6302.                     _again:
  6303.                     if Count>0 then
  6304.                         for q:=0 to Count-1 do
  6305.                             if At(q)<>nil then
  6306.                                 if PXAccAttr(At(q))^.apID=OrgID then
  6307.                                     begin
  6308.                                         AtFree(q);
  6309.                                         goto _again
  6310.                                     end
  6311.                 end
  6312.     end;
  6313.  
  6314.  
  6315. function TApplication.XAccText(OrgID: integer; pText: pointer): boolean;
  6316.  
  6317.     begin
  6318.         XAccText:=false
  6319.     end;
  6320.  
  6321.  
  6322. function TApplication.XAccKey(OrgID,Stat,Key: integer): boolean;
  6323.  
  6324.     begin
  6325.         XAccKey:=false
  6326.     end;
  6327.  
  6328.  
  6329. function TApplication.XAccMeta(OrgID: integer; pData: pointer; lData: longint; Final: boolean): boolean;
  6330.  
  6331.     begin
  6332.         XAccMeta:=false
  6333.     end;
  6334.  
  6335.  
  6336. function TApplication.XAccIMG(OrgID: integer; pData: pointer; lData: longint; Final: boolean): boolean;
  6337.  
  6338.     begin
  6339.         XAccIMG:=false
  6340.     end;
  6341.  
  6342.  
  6343. procedure TApplication.AVProtokoll(OrgID: integer; Msg: word; AName: string);
  6344.     var pipe: Pipearray;
  6345.  
  6346.     begin
  6347.         AVInsert(OrgID,0,Msg,AName);
  6348.         pipe[0]:=VA_PROTOSTATUS;
  6349.         pipe[1]:=apID;
  6350.         pipe[2]:=0;
  6351.         pipe[3]:=integer(XAcc.AVSrvMsg);
  6352.         pipe[4]:=0;
  6353.         pipe[5]:=0;
  6354.         pipe[6]:=integer((longint(apName)+1) div 65536);
  6355.         pipe[7]:=integer((longint(apName)+1) mod 65536);
  6356.         appl_write(OrgID,16,@pipe)
  6357.     end;
  6358.  
  6359.  
  6360. procedure TApplication.VAProtoStatus(OrgID: integer; Msg: word; AName: string);
  6361.  
  6362.     begin
  6363.         AVServer:=OrgID;
  6364.         AVInsert(OrgID,Msg,0,AName)
  6365.     end;
  6366.  
  6367.  
  6368. function TApplication.AVInsert(accID: integer; SrvMsg,AccMsg: word; AName: string): boolean;
  6369.     var pxattr: PXAccAttr;
  6370.         xattr : TXAccAttr;
  6371.  
  6372.     begin
  6373.         AVInsert:=false;
  6374.         if FindApplication('',accID,xattr) then
  6375.             if bTst(xattr.Protocol,PROTO_AV) then exit;
  6376.         if XAccList=nil then XAccList:=new(PXAccCollection,Init(5,5));
  6377.         if XAccList=nil then exit;
  6378.         new(pxattr);
  6379.         if pxattr<>nil then
  6380.             begin
  6381.                 with pxattr^ do
  6382.                     begin
  6383.                         AppTypeHR:=nil;
  6384.                         ExtFeatures:=nil;
  6385.                         GenericName:=nil;
  6386.                         AVSrvMsg:=SrvMsg;
  6387.                         AVAccMsg:=AccMsg;
  6388.                         apID:=accID;
  6389.                         if lastfa<0 then
  6390.                             begin
  6391.                                 Protocol:=PROTO_AV;
  6392.                                 Version:=0;
  6393.                                 MsgGroups:=0;
  6394.                                 menuID:=-1;
  6395.                                 AppTypeMR:='';
  6396.                                 pXDSC:=nil;
  6397.                                 Name:=NewStr(StrPTrimF(AName))
  6398.                             end
  6399.                         else
  6400.                             begin
  6401.                                 Protocol:=xattr.Protocol or PROTO_AV;
  6402.                                 Version:=xattr.Version;
  6403.                                 MsgGroups:=xattr.MsgGroups;
  6404.                                 menuID:=xattr.menuID;
  6405.                                 AppTypeMR:=xattr.AppTypeMR;
  6406.                                 if xattr.Name<>nil then Name:=NewStr(xattr.Name^)
  6407.                                 else
  6408.                                     Name:=nil;
  6409.                                 if xattr.AppTypeHR<>nil then AppTypeHR:=NewStr(xattr.AppTypeHR^);
  6410.                                 if xattr.GenericName<>nil then GenericName:=NewStr(xattr.GenericName^);
  6411.                                 if xattr.ExtFeatures<>nil then ExtFeatures:=NewStr(xattr.ExtFeatures^);
  6412.                                 pXDSC:=xattr.pXDSC
  6413.                             end
  6414.                     end;
  6415.                 if lastfa>=0 then XAccList^.AtFree(lastfa);
  6416.                 XAccList^.Insert(pxattr);
  6417.                 AVInsert:=true
  6418.             end
  6419.     end;
  6420.  
  6421.  
  6422. procedure TApplication.AVExit(OrgID: integer);
  6423.     label _again;
  6424.  
  6425.     var q: longint;
  6426.  
  6427.     begin
  6428.         if XAccList<>nil then
  6429.             with XAccList^ do
  6430.                 begin
  6431.                     _again:
  6432.                     if Count>0 then
  6433.                         for q:=0 to Count-1 do
  6434.                             if At(q)<>nil then
  6435.                                 with PXAccAttr(At(q))^ do
  6436.                                     if apID=OrgID then
  6437.                                         if bTst(Protocol,PROTO_AV) then
  6438.                                             begin
  6439.                                                 if apID=AVServer then AVServer:=id_No;
  6440.                                                 Protocol:=Protocol and not(PROTO_AV);
  6441.                                                 if Protocol=0 then AtFree(q)
  6442.                                                 else
  6443.                                                     begin
  6444.                                                         AVSrvMsg:=0;
  6445.                                                         AVAccMsg:=0
  6446.                                                     end;
  6447.                                                 goto _again
  6448.                                             end
  6449.                 end
  6450.     end;
  6451.  
  6452.  
  6453. function TApplication.DDGetPreferredTypes(WindID: integer): string;
  6454.  
  6455.     begin
  6456.         DDGetPreferredTypes:=''
  6457.     end;
  6458.  
  6459.  
  6460. function TApplication.DDGetPath(WindID: integer): string;
  6461.  
  6462.     begin
  6463.         DDGetPath:=''
  6464.     end;
  6465.  
  6466.  
  6467. function TApplication.DDHeaderReply(dType,dName,fName: string; dSize: longint; WindID,OrgID,mX,mY,KStat: integer): byte;
  6468.  
  6469.     begin
  6470.         DDHeaderReply:=DD_NAK
  6471.     end;
  6472.  
  6473.  
  6474. function TApplication.DDReadData(dType,dName,fName: string; dSize: longint; PipeHnd,WindID,OrgID,mX,mY,KStat: integer): boolean;
  6475.  
  6476.     begin
  6477.         DDReadData:=false
  6478.     end;
  6479.  
  6480.  
  6481. function TApplication.DDReadArgs(dSize: longint; PipeHnd,WindID,OrgID,mX,mY,KStat: integer): boolean;
  6482.     var buffer: array [0..127] of byte;
  6483.  
  6484.     begin
  6485.         DDReadArgs:=false;
  6486.         if dSize<=0 then exit;
  6487.         while dSize>128 do
  6488.             begin
  6489.                 if fread(PipeHnd,128,@buffer)<>128 then exit;
  6490.                 dec(dSize,128)
  6491.             end;
  6492.         fread(PipeHnd,dSize,@buffer)
  6493.     end;
  6494.  
  6495.  
  6496. procedure TApplication.DDFinished(OrgID,WindID,mX,mY,KStat: integer);
  6497.  
  6498.     begin
  6499.     end;
  6500.  
  6501.  
  6502. procedure TApplication.HandleDragDrop(PipeHnd,OrgID,WindID,mX,mY,KStat: integer);
  6503.     label _readhdr,_prefext;
  6504.  
  6505.     var answer           : string;
  6506.         hdrlen,i         : integer;
  6507.         dtype            : string[4];
  6508.         dsize            : longint;
  6509.         dname,ndata,nfile: string[DD_NAMEMAX];
  6510.  
  6511.     begin
  6512.         answer:=chr(DD_OK);
  6513.         if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  6514.         _prefext:
  6515.         answer:=StrPLeft(DDGetPreferredTypes(WindID),DD_EXTSIZE);
  6516.         while length(answer)<DD_EXTSIZE do answer:=answer+#0;
  6517.         if fwrite(PipeHnd,DD_EXTSIZE,@answer[1])<>DD_EXTSIZE then exit;
  6518.         _readhdr:
  6519.         if fread(PipeHnd,2,@hdrlen)<>2 then exit;
  6520.         if hdrlen<9 then exit;
  6521.         dtype:='    ';
  6522.         if fread(PipeHnd,4,@dtype[1])<>4 then exit;
  6523.         if fread(PipeHnd,4,@dsize)<>4 then exit;
  6524.         dec(hdrlen,8);
  6525.         if hdrlen>DD_NAMEMAX then i:=DD_NAMEMAX
  6526.         else
  6527.             i:=hdrlen;
  6528.         fillchar(dname,sizeof(dname),0);
  6529.         if fread(PipeHnd,i,@dname[1])<>i then exit;
  6530.         dec(hdrlen,i);
  6531.         ndata:='';
  6532.         nfile:='';
  6533.         i:=1;
  6534.         while dname[i]<>#0 do
  6535.             begin
  6536.                 ndata:=ndata+dname[i];
  6537.                 inc(i)
  6538.             end;
  6539.         inc(i);
  6540.         while dname[i]<>#0 do
  6541.             begin
  6542.                 nfile:=nfile+dname[i];
  6543.                 inc(i)
  6544.             end;
  6545.         while hdrlen>DD_NAMEMAX+1 do
  6546.             begin
  6547.                 if fread(PipeHnd,DD_NAMEMAX+1,@dname)<>DD_NAMEMAX+1 then exit;
  6548.                 dec(hdrlen,DD_NAMEMAX+1)
  6549.             end;
  6550.         if hdrlen>0 then
  6551.             if fread(PipeHnd,hdrlen,@dname)<>hdrlen then exit;
  6552.         if dtype='PATH' then
  6553.             begin
  6554.                 answer:=StrPTrimF(DDGetPath(WindID));
  6555.                 if length(answer)=0 then answer:=chr(DD_NAK)
  6556.                 else
  6557.                     answer:=StrPLeft(chr(DD_OK)+answer,dsize);
  6558.                 fwrite(PipeHnd,length(answer),@answer[1]);
  6559.                 exit
  6560.             end;
  6561.         if dtype='ARGS' then
  6562.             begin
  6563.                 answer:=chr(DD_OK);
  6564.                 if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  6565.                 if dsize>0 then
  6566.                     if DDReadArgs(dsize,PipeHnd,WindID,OrgID,mX,mY,KStat) then ddokflag:=true;
  6567.                 exit
  6568.             end;
  6569.         answer:=chr(DDHeaderReply(dtype,ndata,nfile,dsize,WindID,OrgID,mX,mY,KStat));
  6570.         if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  6571.         case ord(answer[1]) of
  6572.             DD_OK:  if DDReadData(dtype,ndata,nfile,dsize,PipeHnd,WindID,OrgID,mX,mY,KStat) then ddokflag:=true;
  6573.             DD_EXT: goto _readhdr;
  6574.             DD_LEN: goto _prefext
  6575.         end
  6576.     end;
  6577.  
  6578.  
  6579. procedure TApplication.HandleKeybd(Stat,Key: integer);
  6580.   var p: PWindow;
  6581.  
  6582.     begin
  6583.         p:=GetPTopWindow;
  6584.         if p<>nil then p^.WMKeyDown(Stat,Key)
  6585.     end;
  6586.  
  6587.  
  6588. procedure TApplication.HandleButton(mX,mY,BStat,KStat,Clicks: integer);
  6589.  
  6590.     begin
  6591.     end;
  6592.  
  6593.  
  6594. procedure TApplication.HandleM1(mX,mY,BStat,KStat: integer);
  6595.  
  6596.     begin
  6597.         if pcrswatch<>nil then
  6598.             if not(IsMouseBusy) then
  6599.                 begin
  6600.                     wind_update(BEG_UPDATE);
  6601.                     Attr.EventMask:=(Attr.EventMask and not(MU_M1)) or MU_M2;
  6602.                     wmnr:=GP.mnr;
  6603.                     wmform:=GP.mform;
  6604.                     if pcrswatch^.Class.hCursor>$7fff then graf_mouse(USER_DEF,pointer(pcrswatch^.Class.hCursor))
  6605.                     else
  6606.                         graf_mouse(pcrswatch^.Class.hCursor,nil);
  6607.                     wind_update(END_UPDATE)
  6608.                 end
  6609.     end;
  6610.  
  6611.  
  6612. procedure TApplication.HandleM2(mX,mY,BStat,KStat: integer);
  6613.  
  6614.     begin
  6615.         if pcrswatch<>nil then
  6616.             begin
  6617.                 wind_update(BEG_UPDATE);
  6618.                 Attr.EventMask:=(Attr.EventMask and not(MU_M2)) or MU_M1;
  6619.                 if not(IsMouseBusy) then graf_mouse(wmnr,@wmform);
  6620.                 wind_update(END_UPDATE)
  6621.             end
  6622.     end;
  6623.  
  6624.  
  6625. procedure TApplication.HandleMesag(Pipe: Pipearray);
  6626.  
  6627.     begin
  6628.     end;
  6629.  
  6630.  
  6631. procedure TApplication.HandleAV(Pipe: Pipearray);
  6632.  
  6633.     begin
  6634.     end;
  6635.  
  6636.  
  6637. procedure TApplication.HandleXAcc(Pipe: Pipearray);
  6638.  
  6639.     begin
  6640.     end;
  6641.  
  6642.  
  6643. procedure TApplication.HandleTimer;
  6644.  
  6645.     begin
  6646.     end;
  6647.  
  6648.  
  6649. procedure TApplication.HandleMenu(meNum: integer);
  6650.  
  6651.     begin
  6652.     end;
  6653.  
  6654.  
  6655. procedure TApplication.HandleError;
  6656.  
  6657.     begin
  6658.         if Status=em_OutOfMemory then Status:=em_OK
  6659.     end;
  6660.  
  6661.  
  6662. procedure TApplication.Terminate;
  6663.  
  6664.     begin
  6665.     end;
  6666.  
  6667.  
  6668. procedure TApplication.Run;
  6669.  
  6670.   begin
  6671.     if AppFlag then ArrowMouse;
  6672.     if Status>=em_OK then
  6673.         begin
  6674.             termflag:=true;
  6675.             MessageLoop
  6676.             end
  6677.   end;
  6678.  
  6679.  
  6680. procedure TApplication.Quit;
  6681.  
  6682.     begin
  6683.         Status:=em_Quit
  6684.     end;
  6685.  
  6686.  
  6687. function TApplication.At(Index: integer): PWindow;
  6688.     var len: integer;
  6689.         p  : PWindow;
  6690.  
  6691.     begin
  6692.         len:=0;
  6693.         p:=MainWindow;
  6694.         while p<>nil do
  6695.             begin
  6696.                 inc(len);
  6697.                 p:=p^.Nxt
  6698.             end;
  6699.         At:=nil;
  6700.         if (Index<0) or (len=0) then exit;
  6701.         Index:=Index mod len;
  6702.         p:=MainWindow;
  6703.         if Index>0 then
  6704.             for len:=0 to Index-1 do p:=p^.Nxt;
  6705.         At:=p
  6706.     end;
  6707.  
  6708.  
  6709. function TApplication.IndexOf(Item: PWindow): integer;
  6710.     var count: integer;
  6711.         p    : PWindow;
  6712.  
  6713.     begin
  6714.         IndexOf:=-1;
  6715.         count:=0;
  6716.         p:=MainWindow;
  6717.         while p<>nil do
  6718.             begin
  6719.                 if p=Item then
  6720.                     begin
  6721.                         IndexOf:=count;
  6722.                         exit
  6723.                     end;
  6724.                 inc(count);
  6725.                 p:=p^.Nxt
  6726.             end
  6727.     end;
  6728.  
  6729.  
  6730. function TApplication.FirstWndThat(Test: PIterationFunc): PWindow;
  6731.     var p,pc: PWindow;
  6732.         cl  : IterationFunc;
  6733.  
  6734.     begin
  6735.         FirstWndThat:=nil;
  6736.         p:=MainWindow;
  6737.         cl:=IterationFunc(Test);
  6738.         while p<>nil do
  6739.             begin
  6740.                 if cl(p) then
  6741.                     begin
  6742.                         FirstWndThat:=p;
  6743.                         exit
  6744.                     end;
  6745.                 pc:=p^.FirstWndThat(Test);
  6746.                 if pc<>nil then
  6747.                     begin
  6748.                         FirstWndThat:=pc;
  6749.                         exit
  6750.                     end;
  6751.                 p:=p^.Nxt
  6752.             end;
  6753.     end;
  6754.  
  6755.  
  6756. procedure TApplication.ForEachWnd(Action: PIterationProc);
  6757.     var p : PWindow;
  6758.         cl: IterationProc;
  6759.  
  6760.     begin
  6761.         p:=MainWindow;
  6762.         cl:=IterationProc(Action);
  6763.         while p<>nil do
  6764.             begin
  6765.                 cl(p);
  6766.                 p^.ForEachWnd(Action);
  6767.                 p:=p^.Nxt
  6768.             end
  6769.     end;
  6770.  
  6771.  
  6772. procedure TApplication.IconPaint(Work: GRECT; var PaintInfo: TPaintStruct);
  6773.  
  6774.     begin
  6775.     end;
  6776.  
  6777.  
  6778. procedure TApplication.BubbleHelp(mX,mY: integer; Delay: word; Hlp: string);
  6779.     label _memfail;
  6780.  
  6781.     var pxy                 : ARRAY_4;
  6782.         bpxy                : record
  6783.                                 case integer of
  6784.                                   0: (b8     : ARRAY_8);
  6785.                                   1: (b41,b42: ARRAY_4)
  6786.                               end;
  6787.         scrn,backgr         : MFDB;
  6788.         dummy,cw,loffs,lanz : integer;
  6789.         xpos,ypos,xc,yc,mlen: integer;
  6790.         blen,ql             : longint;
  6791.         pipe                : Pipearray;
  6792.         qp                  : pointer;
  6793.         qused               : boolean;
  6794.  
  6795.     begin
  6796.         if length(Hlp)=0 then exit;
  6797.         wind_update(BEG_UPDATE);
  6798.         wind_update(BEG_MCTRL);
  6799.         InitVWrk;
  6800.         HideMouse;
  6801.         pxy[0]:=0;
  6802.         pxy[1]:=0;
  6803.         pxy[2]:=Attr.MaxPX;
  6804.         pxy[3]:=Attr.MaxPY;
  6805.         vs_clip(vdiHandle,CLIP_ON,pxy);
  6806.         gem.vst_alignment(vdiHandle,TA_LEFT,TA_TOP,dummy,dummy);
  6807.         gem.vst_height(vdiHandle,SysInfo.SFHeight,dummy,dummy,cw,loffs);
  6808.         Hlp:=AlertBubbleWrap(Hlp,Min(37,(Attr.MaxPX div cw)-2));
  6809.         lanz:=1;
  6810.         mlen:=0;
  6811.         xpos:=1;
  6812.         for dummy:=1 to length(Hlp) do
  6813.             if Hlp[dummy]='|' then
  6814.                 begin
  6815.                     if dummy-xpos>mlen then mlen:=dummy-xpos;
  6816.                     xpos:=dummy+1;
  6817.                     inc(lanz)
  6818.                 end;
  6819.         if length(Hlp)+1-xpos>mlen then mlen:=length(Hlp)+1-xpos;
  6820.         xpos:=mX-((mlen*cw) shr 2);
  6821.         ypos:=mY-(lanz+2)*loffs;
  6822.         if xpos+(mlen+1)*cw>Attr.MaxPX then xpos:=Attr.MaxPX-(mlen+1)*cw;
  6823.         if ypos<=(loffs shr 1) then
  6824.             begin
  6825.                 ypos:=(loffs shr 1)+1;
  6826.                 if ypos+(lanz+2)*loffs>mY then
  6827.                     begin
  6828.                         ypos:=mY+((loffs*3) shr 1);
  6829.                         xpos:=mX-((mlen*cw) shr 2)*3
  6830.                     end
  6831.             end;
  6832.         if xpos<=cw then xpos:=cw+1;
  6833.         pxy[0]:=xpos-cw;
  6834.         pxy[1]:=ypos-(loffs shr 1);
  6835.         pxy[2]:=pxy[0]+(mlen+2)*cw;
  6836.         pxy[3]:=pxy[1]+(lanz+1)*loffs;
  6837.         xc:=xpos+((mlen*cw) shr 1);
  6838.         bpxy.b8[0]:=pxy[0]-2;
  6839.         bpxy.b8[2]:=pxy[2]+1;
  6840.         if pxy[1]<mY then
  6841.             begin
  6842.                 yc:=pxy[3];
  6843.                 bpxy.b8[1]:=pxy[1]-2;
  6844.                 bpxy.b8[3]:=mY+4
  6845.             end
  6846.         else
  6847.             begin
  6848.                 yc:=pxy[1];
  6849.                 bpxy.b8[1]:=mY-4;
  6850.                 bpxy.b8[3]:=pxy[3]+1
  6851.             end;
  6852.         if bpxy.b8[0]<0 then bpxy.b8[0]:=0;
  6853.         if bpxy.b8[1]<0 then bpxy.b8[1]:=0;
  6854.         if bpxy.b8[2]>Attr.MaxPX then bpxy.b8[2]:=Attr.MaxPX;
  6855.         if bpxy.b8[3]>Attr.MaxPY then bpxy.b8[3]:=Attr.MaxPY;
  6856.         with backgr do
  6857.             begin
  6858.                 fd_w:=bpxy.b8[2]+1-bpxy.b8[0];
  6859.                 fd_h:=bpxy.b8[3]+1-bpxy.b8[1];
  6860.                 fd_stand:=FF_DEVSPEC;
  6861.                 fd_wdwidth:=(fd_w+15) shr 4;
  6862.                 fd_nplanes:=Attr.Planes;
  6863.                 blen:=(longint(fd_wdwidth)*longint(fd_h)*longint(fd_nplanes)) shl 1
  6864.             end;
  6865.         if IsQSBUsed then ql:=-1
  6866.         else
  6867.             GetQSB(qp,ql);
  6868.         qused:=(ql>=blen);
  6869.         if qused then
  6870.             begin
  6871.                 backgr.fd_addr:=qp;
  6872.                 IsQSBUsed:=true
  6873.             end
  6874.         else
  6875.             getmem(backgr.fd_addr,blen);
  6876.         if backgr.fd_addr=nil then goto _memfail;
  6877.         scrn.fd_addr:=nil;
  6878.         bpxy.b8[4]:=0;
  6879.         bpxy.b8[5]:=0;
  6880.         bpxy.b8[6]:=backgr.fd_w-1;
  6881.         bpxy.b8[7]:=backgr.fd_h-1;
  6882.         vro_cpyfm(vdiHandle,S_ONLY,bpxy.b8,scrn,backgr);
  6883.         gem.vsf_interior(vdiHandle,FIS_SOLID);
  6884.         v_rfbox(vdiHandle,pxy);
  6885.         for dummy:=0 to 3 do dec(pxy[dummy]);
  6886.         gem.vsf_interior(vdiHandle,FIS_HOLLOW);
  6887.         v_rfbox(vdiHandle,pxy);
  6888.         dummy:=round(sqrt(sqr(mX-xc)+sqr(mY-yc))/6);
  6889.         pxya[0]:=xc-dummy;
  6890.         pxya[1]:=yc-1;
  6891.         pxya[2]:=xc+dummy;
  6892.         pxya[3]:=pxya[1];
  6893.         pxya[4]:=mX;
  6894.         pxya[5]:=mY;
  6895.         pxya[6]:=pxya[0];
  6896.         pxya[7]:=pxya[1];
  6897.         v_fillarea(vdiHandle,4,pxya);
  6898.         inc(pxya[0]);
  6899.         dec(pxya[2]);
  6900.         gem.vsl_color(vdiHandle,White);
  6901.         v_pline(vdiHandle,2,pxya);
  6902.         gem.vsl_color(vdiHandle,Black);
  6903.         pxya[4]:=pxya[2];
  6904.         pxya[5]:=pxya[3];
  6905.         pxya[2]:=mX;
  6906.         pxya[3]:=mY;
  6907.         v_pline(vdiHandle,3,pxya);
  6908.         dummy:=pos('|',Hlp);
  6909.         while dummy>0 do
  6910.             begin
  6911.                 v_gtext(vdiHandle,xpos,ypos,StrPLeft(Hlp,dummy-1));
  6912.                 Hlp:=StrPRight(Hlp,length(Hlp)-dummy);
  6913.                 inc(ypos,loffs);
  6914.                 dummy:=pos('|',Hlp)
  6915.             end;
  6916.         v_gtext(vdiHandle,xpos,ypos,Hlp);
  6917.         ShowMouse;
  6918.         graf_mouse(MFORCE or IDC_HELP,pointer(1));
  6919.         repeat
  6920.             graf_mkstate(dummy,dummy,cw,dummy)
  6921.         until cw=0;
  6922.         evnt_timer(Delay,0);
  6923.         evnt_multi(MU_KEYBD or MU_BUTTON or MU_M1,257,3,0,1,mX-8,mY-8,17,17,0,0,0,0,0,pipe,0,0,dummy,dummy,dummy,dummy,dummy,dummy);
  6924.         HideMouse;
  6925.         scrn.fd_addr:=nil;
  6926.         pxy:=bpxy.b41;
  6927.         bpxy.b41:=bpxy.b42;
  6928.         bpxy.b42:=pxy;
  6929.         vro_cpyfm(vdiHandle,S_ONLY,bpxy.b8,backgr,scrn);
  6930.         if qused then IsQSBUsed:=false
  6931.         else
  6932.             freemem(backgr.fd_addr,blen);
  6933.         _memfail:
  6934.         RestoreVWrk;
  6935.         ShowMouse;
  6936.         gem.graf_mouse(GP.mnr,@GP.mform);
  6937.         repeat
  6938.             graf_mkstate(dummy,dummy,cw,dummy)
  6939.         until not(bTst(cw,2));
  6940.         wind_update(END_MCTRL);
  6941.         wind_update(END_UPDATE)
  6942.     end;
  6943.  
  6944.  
  6945. function TApplication.ExecDialog(ADialog: PDialog): integer;
  6946.  
  6947.     begin
  6948.         if ADialog=nil then ExecDialog:=em_InvalidDialog
  6949.         else
  6950.             begin
  6951.                 with ADialog^ do
  6952.                     begin
  6953.                         Attr.ExStyle:=(Attr.ExStyle and not(ws_ex_TryModeless)) or ws_ex_Center2Parent;
  6954.                         Result:=em_InvalidDialog;
  6955.                         MakeWindow;
  6956.                         ExecDialog:=Result
  6957.                     end;
  6958.                 ADialog^.Free
  6959.             end
  6960.     end;
  6961.  
  6962.  
  6963. function TApplication.Alert(AParent: PWindow; DefBtn: integer; Sign: longint; Txt,Btn: string): integer;
  6964.     const alertref: array [0..3] of AESOBJECT =
  6965.                     ((ob_next:-1;ob_head:1;ob_tail:4;ob_type:G_BOX;ob_flags:NONE;ob_state:OUTLINED;ob_spec:(index:$11100);ob_x:2;ob_y:1;ob_width:38;ob_height:6),
  6966.                      (ob_next:3;ob_head:-1;ob_tail:-1;ob_type:G_BUTTON;ob_flags:SELECTABLE or F_EXIT;ob_state:NORMAL;ob_spec:(free_string:nil);ob_x:27;ob_y:4;ob_width:9;ob_height:1),
  6967.                      (ob_next:4;ob_head:-1;ob_tail:-1;ob_type:G_STRING;ob_flags:NONE;ob_state:NORMAL;ob_spec:(free_string:nil);ob_x:27;ob_y:1;ob_width:6;ob_height:1),
  6968.                      (ob_next:0;ob_head:-1;ob_tail:-1;ob_type:G_IMAGE;ob_flags:NONE;ob_state:NORMAL;ob_spec:(bit_blk:nil);ob_x:2;ob_y:1;ob_width:4;ob_height:2));
  6969.  
  6970.                 highres: array [1..3,0..63] of word =
  6971.                                 (($0003,$c000,$0006,$6000,$000d,$b000,$001b,$d800,$0037,$ec00,
  6972.                                     $006f,$f600,$00dc,$3b00,$01bc,$3d80,$037c,$3ec0,$06fc,$3f60,
  6973.                                     $0dfc,$3fb0,$1bfc,$3fd8,$37fc,$3fec,$6ffc,$3ff6,$dffc,$3ffb,
  6974.                                     $bffc,$3ffd,$bffc,$3ffd,$dffc,$3ffb,$6ffc,$3ff6,$37fc,$3fec,
  6975.                                     $1bff,$ffd8,$0dff,$ffb0,$06fc,$3f60,$037c,$3ec0,$01bc,$3d80,
  6976.                                     $00dc,$3b00,$006f,$f600,$0037,$ec00,$001b,$d800,$000d,$b000,
  6977.                                     $0006,$6000,$0003,$c000),
  6978.                                  ($3fff,$fffc,$c000,$0003,$9fff,$fff9,$bfff,$fffd,$dff8,$3ffb,
  6979.                                     $5fe0,$0ffa,$6fc0,$07f6,$2f83,$83f4,$3787,$c3ec,$1787,$c3e8,
  6980.                                     $1bff,$83d8,$0bff,$07d0,$0dfe,$0fb0,$05fc,$1fa0,$06fc,$3f60,
  6981.                                     $02fc,$3f40,$037c,$3ec0,$017c,$3e80,$01bf,$fd80,$00bf,$fd00,
  6982.                                     $00dc,$3b00,$005c,$3a00,$006c,$3600,$002f,$f400,$0037,$ec00,
  6983.                                     $0017,$e800,$001b,$d800,$000b,$d000,$000d,$b000,$0005,$a000,
  6984.                                     $0006,$6000,$0003,$c000),
  6985.                                  ($007f,$fe00,$00c0,$0300,$01bf,$fd80,$037f,$fec0,$06ff,$ff60,
  6986.                                     $0dff,$ffb0,$1bff,$ffd8,$37ff,$ffec,$6fff,$fff6,$dfff,$fffb,
  6987.                                     $b181,$860d,$a081,$0205,$a4e7,$3265,$a7e7,$3265,$a3e7,$3265,
  6988.                                     $b1e7,$3205,$b8e7,$320d,$bce7,$327d,$a4e7,$327d,$a0e7,$027d,
  6989.                                     $b1e7,$867d,$bfff,$fffd,$dfff,$fffb,$6fff,$fff6,$37ff,$ffec,
  6990.                                     $1bff,$ffd8,$0dff,$ffb0,$06ff,$ff60,$037f,$fec0,$01bf,$fd80,
  6991.                                     $00c0,$0300,$007f,$fe00));
  6992.  
  6993.                 ABACKBOX      = 0;
  6994.                 ABUTTON       = 1;
  6995.                 ASTRING       = 2;
  6996.                 ABITBLOCK     = 3;
  6997.                 ALRT_MAXLINES = 18;
  6998.                 ALRT_MAXBTN   = 12;
  6999.                 ALRT_WBORDER  =  2;
  7000.                 ALRT_HBORDER  =  1;
  7001.                 ALRT_WBINNER  =  1;
  7002.                 ALRT_WBITBLK  =  4;
  7003.                 ALRT_HBITBLK  =  2;
  7004.                 ALRT_HBUTTON  =  1;
  7005.                 ALRT_HTEXT    =  1;
  7006.  
  7007.     var cnttext,cntbutton,objused    : integer;
  7008.         firstbutton,maxbutton,maxtext: integer;
  7009.         firsttext,obj,i,treecnt      : integer;
  7010.         tree                         : PTree;
  7011.         adlg                         : PDialog;
  7012.         pbitblk                      : pointer;
  7013.         bbcalc                       : BITBLK;
  7014.         smfdb                        : MFDB;
  7015.  
  7016.     function counttokens(var s: string; manz: integer): integer;
  7017.         var ret,c: integer;
  7018.  
  7019.         begin
  7020.             ret:=1;
  7021.             for c:=1 to length(s) do
  7022.                 begin
  7023.                     if s[c]='|' then inc(ret);
  7024.                     if ret>manz then
  7025.                         begin
  7026.                             s:=StrPLeft(s,c-1);
  7027.                             dec(ret);
  7028.                             break
  7029.                         end
  7030.                 end;
  7031.             counttokens:=ret
  7032.         end;
  7033.  
  7034.     procedure createalert;
  7035.         var dummy,c         : string;
  7036.             i,max1,max2,xpos: integer;
  7037.  
  7038.         function taketoken: string;
  7039.             var q,l: integer;
  7040.                 tt : string;
  7041.  
  7042.             begin
  7043.                 taketoken:='';
  7044.                 l:=length(dummy);
  7045.                 if l=0 then exit;
  7046.                 q:=1;
  7047.                 while (dummy[q]<>'|') and (q<l) do inc(q);
  7048.                 if dummy[q]='|' then
  7049.                     begin
  7050.                         tt:=StrPLeft(dummy,q-1);
  7051.                         if length(tt)=0 then taketoken:=' ' else taketoken:=tt;
  7052.                         dummy:=StrPRight(dummy,length(dummy)-q);
  7053.                         if length(dummy)=0 then dummy:=' '
  7054.                     end
  7055.                 else
  7056.                     begin
  7057.                         taketoken:=dummy;
  7058.                         dummy:=''
  7059.                     end
  7060.             end;
  7061.  
  7062.         begin
  7063.             tree^[ROOT]:=alertref[ABACKBOX];
  7064.             treecnt:=1;
  7065.             if pbitblk<>nil then
  7066.                 begin
  7067.                     tree^[treecnt]:=alertref[ABITBLOCK];
  7068.                     tree^[treecnt].ob_spec.bit_blk:=pbitblk;
  7069.                     inc(treecnt)
  7070.                 end;
  7071.             obj:=treecnt;
  7072.             firsttext:=treecnt;
  7073.             for i:=0 to cnttext-1 do
  7074.                 begin
  7075.                     tree^[treecnt]:=alertref[ASTRING];
  7076.                     inc(treecnt)
  7077.                 end;
  7078.             maxtext:=0;
  7079.             dummy:=Txt;
  7080.             c:=taketoken;
  7081.             while length(c)>0 do
  7082.                 begin
  7083.                     if maxtext<length(c) then maxtext:=length(c);
  7084.                     tree^[obj].ob_spec.free_string:=ChrNew(c);
  7085.                     inc(obj);
  7086.                     c:=taketoken
  7087.                 end;
  7088.             obj:=treecnt;
  7089.             firstbutton:=treecnt;
  7090.             for i:=0 to cntbutton-1 do
  7091.                 begin
  7092.                     tree^[treecnt]:=alertref[ABUTTON];
  7093.                     inc(treecnt)
  7094.                 end;
  7095.             if (DefBtn>=1) and (DefBtn<=cntButton) then
  7096.                 tree^[obj+DefBtn-1].ob_flags:=tree^[obj+DefBtn-1].ob_flags or DEFAULT;
  7097.             maxbutton:=0;
  7098.             dummy:=Btn;
  7099.             c:=taketoken;
  7100.             while length(c)>0 do
  7101.                 begin
  7102.                     if pos('&',c)>0 then
  7103.                         begin
  7104.                             if maxbutton<length(c)-1 then maxbutton:=length(c)-1
  7105.                         end
  7106.                     else
  7107.                         if maxbutton<length(c) then maxbutton:=length(c);
  7108.                     tree^[obj].ob_spec.free_string:=ChrNew(c);
  7109.                     inc(obj);
  7110.                     c:=taketoken
  7111.                 end;
  7112.             inc(maxbutton);
  7113.             tree^[ROOT].ob_next:=-1;
  7114.             tree^[ROOT].ob_head:=1;
  7115.             tree^[ROOT].ob_tail:=treecnt-1;
  7116.             for i:=1 to treecnt-1 do
  7117.                 begin
  7118.                     tree^[i].ob_next:=i+1;
  7119.                     tree^[i].ob_head:=-1;
  7120.                     tree^[i].ob_tail:=-1
  7121.                 end;
  7122.             tree^[treecnt-1].ob_flags:=tree^[treecnt-1].ob_flags or LASTOB;
  7123.             tree^[treecnt-1].ob_next:=ROOT;
  7124.             max1:=ALRT_WBORDER+maxtext;
  7125.             if pbitblk<>nil then inc(max1,ALRT_WBINNER+ALRT_WBITBLK);
  7126.             max2:=cntbutton*(maxbutton+ALRT_WBORDER);
  7127.             tree^[ROOT].ob_width:=ALRT_WBORDER+max(max1,max2);
  7128.             tree^[ROOT].ob_height:=(3*ALRT_HBORDER+ALRT_HBUTTON)+cnttext;
  7129.             obj:=1;
  7130.             if pbitblk<>nil then
  7131.                 begin
  7132.                     tree^[obj].ob_x:=ALRT_WBORDER;
  7133.                     tree^[obj].ob_y:=ALRT_HBORDER;
  7134.                     tree^[obj].ob_width:=ALRT_WBITBLK;
  7135.                     tree^[obj].ob_height:=ALRT_HBITBLK;
  7136.                     inc(obj)
  7137.                 end;
  7138.             i:=1;
  7139.             while (tree^[obj].ob_type=G_STRING) do
  7140.                 begin
  7141.                     tree^[obj].ob_x:=ALRT_WBORDER;
  7142.                     if pbitblk<>nil then inc(tree^[obj].ob_x,ALRT_WBITBLK+ALRT_WBINNER);
  7143.                     tree^[obj].ob_y:=i;
  7144.                     tree^[obj].ob_width:=maxtext;
  7145.                     tree^[obj].ob_height:=ALRT_HTEXT;
  7146.                     inc(obj);
  7147.                     inc(i)
  7148.                 end;
  7149.             inc(i);
  7150.             xpos:=tree^[ROOT].ob_width-cntbutton*(maxbutton+ALRT_WBORDER);
  7151.             dec(obj);
  7152.             repeat
  7153.                 inc(obj);
  7154.                 tree^[obj].ob_x:=xpos;
  7155.                 tree^[obj].ob_y:=i;
  7156.                 tree^[obj].ob_width:=maxbutton;
  7157.                 tree^[obj].ob_height:=ALRT_HBUTTON;
  7158.                 inc(xpos,maxbutton+ALRT_WBORDER)
  7159.             until bTst(tree^[obj].ob_flags,LASTOB);
  7160.             for i:=0 to treecnt-1 do rsrc_obfix(tree,i)
  7161.         end;
  7162.  
  7163.     begin
  7164.         Alert:=id_No;
  7165.         pbitblk:=nil;
  7166.         if Sign>$7fff then pbitblk:=pointer(Sign)
  7167.         else
  7168.             if (Sign>NO_ICON) and (Sign<=STOP) then
  7169.                 begin
  7170.                     with bbcalc do
  7171.                         begin
  7172.                             bi_pdata:=@highres[Sign];
  7173.                             bi_wb:=4;
  7174.                             bi_hl:=32;
  7175.                             bi_x:=0;
  7176.                             bi_y:=0;
  7177.                             case Sign of
  7178.                                 NOTE: if SysInfo.BGDefCol<>White then bi_color:=Yellow
  7179.                                       else
  7180.                                           bi_color:=LBlack;
  7181.                                 WAIT: bi_color:=Blue;
  7182.                                 STOP: bi_color:=Red
  7183.                             else
  7184.                                 bi_color:=Black
  7185.                             end
  7186.                         end;
  7187.                     pbitblk:=@bbcalc
  7188.                 end;
  7189.         if length(Txt)=0 then Txt:=' '
  7190.         else
  7191.             begin
  7192.                 if pbitblk=nil then Txt:=AlertBubbleWrap(Txt,Min(50,(Attr.MaxPX div SysInfo.SFWidth)-5))
  7193.                 else
  7194.                     txt:=AlertBubbleWrap(Txt,Min(50,(Attr.MaxPX div SysInfo.SFWidth)-10))
  7195.             end;
  7196.         cnttext:=counttokens(Txt,ALRT_MAXLINES);
  7197.         if (cnttext=1) and (pbitblk<>nil) then
  7198.             begin
  7199.                 Txt:='|'+StrPLeft(Txt,254);
  7200.                 cnttext:=2
  7201.             end;
  7202.         cntbutton:=counttokens(Btn,ALRT_MAXBTN);
  7203.         objused:=cnttext+cntbutton+2;
  7204.         getmem(tree,objused*sizeof(AESOBJECT));
  7205.         if tree=nil then exit;
  7206.         createalert;
  7207.         new(adlg,Init(AParent,Name^,id_No));
  7208.         if adlg=nil then
  7209.             begin
  7210.                 freemem(tree,objused*sizeof(AESOBJECT));
  7211.                 exit
  7212.             end
  7213.         else
  7214.             with adlg^ do
  7215.                 begin
  7216.                     SetDlgTree(tree);
  7217.                     SetupSize
  7218.                 end;
  7219.         for i:=firstbutton to firstbutton+cntbutton-1 do new(PButton,Init(adlg,i,id_No,true,''));
  7220.         i:=Attr.Style and as_GrowShrink;
  7221.         if (Sign>NO_ICON) and (Sign<=STOP) then
  7222.             begin
  7223.                 vdi_fix(smfdb,pbitblk,tree^[1].ob_width,tree^[1].ob_height);
  7224.                 vr_convert(vdiHandle,smfdb,FF_DEVSPEC);
  7225.                 smfdb.fd_stand:=FF_DEVSPEC
  7226.             end;
  7227.         Attr.Style:=Attr.Style and not(as_GrowShrink);
  7228.         with adlg^ do
  7229.             begin
  7230.                 Attr.ExStyle:=(Attr.ExStyle and not(ws_ex_TryModeless)) or ws_ex_Center2Parent or ws_ex_MoveTransparent;
  7231.                 Result:=em_InvalidDialog;
  7232.                 MakeWindow;
  7233.                 if Result>ROOT then Alert:=Result+1-firstbutton
  7234.             end;
  7235.         Attr.Style:=Attr.Style or i;
  7236.         if (Sign>NO_ICON) and (Sign<=STOP) then vr_convert(vdiHandle,smfdb,FF_STAND);
  7237.         adlg^.Free;
  7238.         for i:=firsttext to firsttext+cnttext+cntbutton-1 do ChrDispose(PChar(tree^[i].ob_spec.free_string));
  7239.         freemem(tree,objused*sizeof(AESOBJECT))
  7240.     end;
  7241.  
  7242.  
  7243. function TApplication.Popup(APopup: PPopup; x,y,Flag: integer): integer;
  7244.     var res: integer;
  7245.  
  7246.     begin
  7247.         res:=id_No;
  7248.         if APopup<>nil then
  7249.             begin
  7250.                 with APopup^ do
  7251.                     begin
  7252.                         pX:=x;
  7253.                         pY:=y;
  7254.                         pFlag:=Flag;
  7255.                         res:=Execute
  7256.                     end;
  7257.                 APopup^.Free
  7258.             end;
  7259.         Popup:=res
  7260.     end;
  7261.  
  7262.  
  7263. function TApplication.Rubbox(WHnd,x,y,xmin,ymin,xmax,ymax: integer; var r: GRECT): boolean;
  7264.     var x2,y2,mx,my,mk,dummy: integer;
  7265.         box,cl              : GRECT;
  7266.         pxy2,pxy3,pxy4      : ptsin_ARRAY;
  7267.         wnd                 : PWindow;
  7268.         fmf                 : word;
  7269.         visible             : boolean;
  7270.  
  7271.     procedure DrawRubbox;
  7272.  
  7273.         begin
  7274.             if wnd=nil then
  7275.                 begin
  7276.                     wind_get(WHnd,WF_FIRSTXYWH,box.X1,box.Y1,box.X2,box.Y2);
  7277.                     while (box.X2>0) and (box.Y2>0) do
  7278.                         begin
  7279.                             inc(box.X2,box.X1-1);
  7280.                             inc(box.Y2,box.Y1-1);
  7281.                             vs_clip(vdiHandle,CLIP_ON,box.A2);
  7282.                             v_pline(vdiHandle,2,pxya);
  7283.                             v_pline(vdiHandle,2,pxy2);
  7284.                             v_pline(vdiHandle,2,pxy3);
  7285.                             v_pline(vdiHandle,2,pxy4);
  7286.                             wind_get(WHnd,WF_NEXTXYWH,box.X1,box.Y1,box.X2,box.Y2)
  7287.                         end
  7288.                 end
  7289.             else
  7290.                 begin
  7291.                     visible:=wnd^.FirstWorkRect(box);
  7292.                     while visible do
  7293.                         begin
  7294.                             vs_clip(vdiHandle,CLIP_ON,box.A2);
  7295.                             v_pline(vdiHandle,2,pxya);
  7296.                             v_pline(vdiHandle,2,pxy2);
  7297.                             v_pline(vdiHandle,2,pxy3);
  7298.                             v_pline(vdiHandle,2,pxy4);
  7299.                             visible:=wnd^.NextWorkRect(box)
  7300.                         end
  7301.                     end
  7302.         end;
  7303.  
  7304.     begin
  7305.         wind_update(BEG_UPDATE);
  7306.         wind_update(BEG_MCTRL);
  7307.         gem.vsl_udsty(vdiHandle,$5555);
  7308.         gem.vsl_type(vdiHandle,LT_USERDEF);
  7309.         gem.vsl_width(vdiHandle,1);
  7310.         gem.vswr_mode(vdiHandle,MD_XOR);
  7311.         fmf:=POINT_HAND;
  7312.         if MultiTOS then fmf:=fmf or MFORCE;
  7313.         gem.graf_mouse(fmf,nil);
  7314.         mx:=x;
  7315.         my:=y;
  7316.         pxya[0]:=x;
  7317.         pxya[1]:=y;
  7318.         pxya[3]:=y;
  7319.         pxy2[1]:=y;
  7320.         pxy3[0]:=x;
  7321.         pxy4[0]:=x;
  7322.         pxy4[1]:=y;
  7323.         pxy4[2]:=x;
  7324.         if WHnd>DESK then wnd:=GetGPWindow(WHnd) else wnd:=nil;
  7325.         HideMouse;
  7326.         repeat
  7327.             x2:=mx;
  7328.             y2:=my;
  7329.             pxya[2]:=x2;
  7330.             pxy2[0]:=x2;
  7331.             pxy2[2]:=x2;
  7332.             pxy2[3]:=y2;
  7333.             pxy3[1]:=y2;
  7334.             pxy3[2]:=x2;
  7335.             pxy3[3]:=y2;
  7336.             pxy4[3]:=y2;
  7337.             if WHnd=DESK then
  7338.                 begin
  7339.                     cl.X1:=Min(x,x2)-DRect.X1;
  7340.                     cl.X2:=Max(x,x2)-DRect.X1;
  7341.                     cl.Y1:=Min(y,y2)-DRect.Y1;
  7342.                     cl.Y2:=Max(y,y2)-DRect.Y1;
  7343.                     A2toGR(cl);
  7344.                     MURBoxChanged(cl)
  7345.                 end
  7346.             else
  7347.                 if wnd<>nil then
  7348.                     begin
  7349.                         cl.X1:=Min(x,x2)-wnd^.Work.X1;
  7350.                         cl.X2:=Max(x,x2)-wnd^.Work.X1;
  7351.                         cl.Y1:=Min(y,y2)-wnd^.Work.Y1;
  7352.                         cl.Y2:=Max(y,y2)-wnd^.Work.Y1;
  7353.                         A2toGR(cl);
  7354.                         wnd^.WMRBoxChanged(cl)
  7355.                     end;
  7356.             DrawRubbox;
  7357.             ShowMouse;
  7358.             repeat
  7359.                 graf_mkstate(mx,my,mk,dummy);
  7360.                 if mx<xmin then mx:=xmin;
  7361.                 if mx>xmax then mx:=xmax;
  7362.                 if my<ymin then my:=ymin;
  7363.                 if my>ymax then my:=ymax;
  7364.                 if wnd<>nil then wnd^.WMRBoxCheck(x,y,xmin,ymin,xmax,ymax,mx,my)
  7365.             until (x2<>mx) or (y2<>my) or (mk<>1);
  7366.             HideMouse;
  7367.             DrawRubbox
  7368.         until (mk<>1);
  7369.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  7370.         ShowMouse;
  7371.         gem.graf_mouse(GP.mnr,@GP.mform);
  7372.         gem.vswr_mode(vdiHandle,GP.wrmode);
  7373.         gem.vsl_width(vdiHandle,GP.lwidth);
  7374.         gem.vsl_type(vdiHandle,GP.ltype);
  7375.         gem.vsl_udsty(vdiHandle,GP.ludsty);
  7376.         wind_update(END_MCTRL);
  7377.         wind_update(END_UPDATE);
  7378.         if (mk=0) and (x<>x2) and (y<>y2) then
  7379.             begin
  7380.                 r.X1:=Min(x,x2);
  7381.                 r.X2:=Max(x,x2);
  7382.                 r.Y1:=Min(y,y2);
  7383.                 r.Y2:=Max(y,y2);
  7384.                 if WHnd=DESK then
  7385.                     begin
  7386.                         dec(r.X1,DRect.X1);
  7387.                         dec(r.X2,DRect.X1);
  7388.                         dec(r.Y1,DRect.Y1);
  7389.                         dec(r.Y2,DRect.Y1)
  7390.                     end
  7391.                 else
  7392.                     if wnd<>nil then
  7393.                         begin
  7394.                             dec(r.X1,wnd^.Work.X1);
  7395.                             dec(r.X2,wnd^.Work.X1);
  7396.                             dec(r.Y1,wnd^.Work.Y1);
  7397.                             dec(r.Y2,wnd^.Work.Y1)
  7398.                         end;
  7399.                 A2toGR(r);
  7400.                 Rubbox:=true
  7401.             end
  7402.         else
  7403.             Rubbox:=false
  7404.     end;
  7405.  
  7406.  
  7407. procedure TApplication.InvalidateRect(Wnd: HWnd; Rect: PGRECT);
  7408.     var p   : PWindow;
  7409.         box : GRECT;
  7410.         pipe: Pipearray;
  7411.  
  7412.     begin
  7413.         wind_update(BEG_UPDATE);
  7414.         p:=GetPWindow(Wnd);
  7415.         if p<>nil then
  7416.             with p^ do
  7417.                 begin
  7418.                     if Rect<>nil then box:=Rect^
  7419.                     else
  7420.                         begin
  7421.                             GetWork;
  7422.                             box:=Work
  7423.                         end;
  7424.                     pipe[0]:=WM_REDRAW;
  7425.                     pipe[1]:=apID;
  7426.                     pipe[2]:=0;
  7427.                     pipe[3]:=Attr.gemHandle;
  7428.                     pipe[4]:=box.X;
  7429.                     pipe[5]:=box.Y;
  7430.                     pipe[6]:=box.W;
  7431.                     pipe[7]:=box.H;
  7432.                     appl_write(apID,16,@pipe)
  7433.                 end;
  7434.         wind_update(END_UPDATE)
  7435.     end;
  7436.  
  7437.  
  7438. procedure TApplication.RestoreModalDialog(p: PWindow);
  7439.     var pinfo     : TPaintStruct;
  7440.         pipe      : Pipearray;
  7441.         pw        : PWindow;
  7442.         evnt,dummy: integer;
  7443.  
  7444.     procedure RestoreParent(pwi: PWindow);
  7445.  
  7446.         begin
  7447.             if pwi<>nil then
  7448.                 begin
  7449.                     if pwi^.IsDialog then
  7450.                         with PDialog(pwi)^ do
  7451.                             begin
  7452.                                 if IsModal then
  7453.                                     begin
  7454.                                         RestoreParent(Parent);
  7455.                                         with pinfo do
  7456.                                             begin
  7457.                                                 rcPaint:=Curr;
  7458.                                                 fErase:=false
  7459.                                             end;
  7460.                                         UpdateDialog;
  7461.                                         InitPaint;
  7462.                                         Paint(pinfo);
  7463.                                         ExitPaint
  7464.                                     end
  7465.                             end
  7466.                 end
  7467.         end;
  7468.  
  7469.     begin
  7470.         if p=nil then exit;
  7471.         if not(p^.IsDialog) then exit;
  7472.         if not(PDialog(p)^.IsModal) then exit;
  7473.         wind_update(BEG_UPDATE);
  7474.         repeat
  7475.             evnt:=evnt_multi(MU_TIMER or MU_MESAG,0,0,0,0,0,0,0,0,0,0,0,0,0,pipe,5,0,dummy,dummy,dummy,dummy,dummy,dummy);
  7476.             if bTst(evnt,MU_MESAG) and (pipe[0]=WM_REDRAW) then
  7477.                 begin
  7478.                     pw:=GetGPWindow(pipe[3]);
  7479.                     if pw<>nil then pw^.WMRedraw(pipe[4],pipe[5],pipe[6],pipe[7])
  7480.                 end
  7481.         until evnt=MU_TIMER;
  7482.         HideMouse;
  7483.         RestoreParent(p);
  7484.         ShowMouse;
  7485.         wind_update(END_UPDATE)
  7486.     end;
  7487.  
  7488.  
  7489. procedure TApplication.DeskRedraw;
  7490.     var box: GRECT;
  7491.  
  7492.     begin
  7493.         wind_update(BEG_UPDATE);
  7494.         wind_get(DESK,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  7495.         while (box.W>0) and (box.H>0) do
  7496.             begin
  7497.                 form_dial(FMD_FINISH,0,0,0,0,box.X,box.Y,box.W,box.H);
  7498.                 wind_get(DESK,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  7499.             end;
  7500.         wind_update(END_UPDATE)
  7501.     end;
  7502.  
  7503.  
  7504. procedure TApplication.SetQuit(mNum,tNum: integer);
  7505.  
  7506.     begin
  7507.         if pquit<>nil then
  7508.             with PQKey(pquit)^ do
  7509.                 begin
  7510.                     VMNum:=mNum;
  7511.                     VTNum:=tNum
  7512.                 end
  7513.     end;
  7514.  
  7515.  
  7516. function TApplication.ChkError: integer;
  7517.  
  7518.     begin
  7519.         ChkError:=Err;
  7520.         Err:=em_OK
  7521.     end;
  7522.  
  7523.  
  7524. function TApplication.ChkSpeedoError: integer;
  7525.  
  7526.     begin
  7527.         ChkSpeedoError:=spderr;
  7528.         spderr:=0
  7529.     end;
  7530.  
  7531.  
  7532. procedure TApplication.Error(ErrorCode: integer);
  7533.  
  7534.     begin
  7535.         if (Attr.Country=FRG) or (Attr.Country=SWG) then
  7536.             case ErrorCode of
  7537.                 em_OK,em_Quit,em_AESNotActive,em_GEMInitFailure,em_Terminate:;
  7538.                 em_InvalidWindow: GOErrAlert(NOTE,'Kein Fenster mehr verfügbar');
  7539.                 em_InvalidMainWindow: GOErrAlert(NOTE,'Hauptfenster nicht verfügbar');
  7540.                 em_AccInitFailure: GOErrAlert(STOP,'Kann Accessory nicht installieren');
  7541.                 em_WOpenFailure: GOErrAlert(NOTE,'Fehler (Fenster öffnen)');
  7542.                 em_WCloseFailure: GOErrAlert(NOTE,'Fehler (Fenster schließen)');
  7543.                 em_WDestroyFailure: GOErrAlert(NOTE,'Fehler (Fenster freigeben)');
  7544.                 em_RscNotFound: GOErrAlert(NOTE,'RSC-Datei nicht gefunden');
  7545.                 em_InvalidMenu: GOErrAlert(NOTE,'Fehler (ungültiges Menü)');
  7546.                 em_InvalidDialog: GOErrAlert(NOTE,'Fehler (ungültiger Dialog)');
  7547.                 em_OutOfMemory: GOErrAlert(STOP,'Kein RAM-Speicher mehr frei')
  7548.             else
  7549.                 GOErrAlert(STOP,'Unbekannter Fehler '+ltoa(ErrorCode))
  7550.             end
  7551.         else
  7552.             case ErrorCode of
  7553.                 em_OK,em_Quit,em_AESNotActive,em_GEMInitFailure,em_Terminate:;
  7554.                 em_InvalidWindow: GOErrAlert(NOTE,'No more windows');
  7555.                 em_InvalidMainWindow: GOErrAlert(NOTE,'Invalid main window');
  7556.                 em_AccInitFailure: GOErrAlert(STOP,'Accessory init Failure');
  7557.                 em_WOpenFailure: GOErrAlert(NOTE,'Window open failure');
  7558.                 em_WCloseFailure: GOErrAlert(NOTE,'Window close failure');
  7559.                 em_WDestroyFailure: GOErrAlert(NOTE,'Window destroy failure');
  7560.                 em_RscNotFound: GOErrAlert(NOTE,'Resource file not found');
  7561.                 em_InvalidMenu: GOErrAlert(NOTE,'Invalid menu structure');
  7562.                 em_InvalidDialog: GOErrAlert(NOTE,'Invalid dialog resource');
  7563.                 em_OutOfMemory: GOErrAlert(STOP,'Error: Out of RAM memory')
  7564.             else
  7565.                 GOErrAlert(STOP,'Unknown error '+ltoa(ErrorCode))
  7566.             end
  7567.     end;
  7568.  
  7569.  
  7570.     { private }
  7571.  
  7572.  
  7573. function TApplication.getcval: longint;
  7574.     var ret: longint;
  7575.  
  7576.     begin
  7577.         ret:=ord(Name^[0]) shl 8;
  7578.         if length(Name^)>0 then ret:=(ret+ord(Name^[1])) shl 8;
  7579.         if length(Name^)>1 then ret:=(ret+ord(Name^[2])) shl 8;
  7580.         getcval:=ret
  7581.     end;
  7582.  
  7583.  
  7584. function TApplication.GetObjectParent(tree: PTree; indx: integer): integer;
  7585.     var p,np: integer;
  7586.  
  7587.     begin
  7588.         p:=-1;
  7589.         np:=tree^[indx].ob_next;
  7590.         while (np>-1) and (p=-1) do
  7591.             begin
  7592.                 if tree^[np].ob_tail=indx then p:=np;
  7593.                 indx:=np;
  7594.                 np:=tree^[indx].ob_next
  7595.             end;
  7596.         GetObjectParent:=p
  7597.     end;
  7598.  
  7599.  
  7600. function TApplication.find_object(tree: PTree; start,which: integer): integer;
  7601.     label _again;
  7602.  
  7603.     var obj,flag,increment,objmax: integer;
  7604.  
  7605.     function IsHidden: boolean;
  7606.         var hid : boolean;
  7607.                 pobj: integer;
  7608.  
  7609.         begin
  7610.             hid:=false;
  7611.             pobj:=obj;
  7612.             while not(hid) and (pobj>-1) do
  7613.                 begin
  7614.                     hid:=bTst(tree^[pobj].ob_flags,HIDETREE);
  7615.                     pobj:=GetObjectParent(tree,pobj)
  7616.                 end;
  7617.             IsHidden:=hid
  7618.         end;
  7619.  
  7620.     begin
  7621.         obj:=0;
  7622.         flag:=EDITABLE;
  7623.         increment:=1;
  7624.         if which=FMD_BACKWARD then increment:=-1;
  7625.         if (which=FMD_BACKWARD) or (which=FMD_FORWARD) then obj:=start+increment;
  7626.         if which=FMD_DEFLT then flag:=DEFAULT;
  7627.         objmax:=0;
  7628.         if tree^[ROOT].ob_head>=0 then
  7629.             repeat
  7630.                 objmax:=tree^[objmax].ob_tail
  7631.             until tree^[objmax].ob_head=-1;
  7632.         _again:
  7633.         while (obj>=0) and (obj<=objmax) do
  7634.             begin
  7635.                 with tree^[obj] do
  7636.                     if bTst(ob_flags,flag) and not(bTst(ob_state,DISABLED)) and not(IsHidden) then
  7637.                         begin
  7638.                             find_object:=obj;
  7639.                             exit
  7640.                         end;
  7641.                 inc(obj,increment)
  7642.             end;
  7643.         if (obj<0) and (start>0) then
  7644.             begin
  7645.                 obj:=objmax;
  7646.                 goto _again
  7647.             end;
  7648.         if (obj>objmax) and (start>0) then
  7649.             begin
  7650.                 obj:=0;
  7651.                 goto _again
  7652.             end;
  7653.         find_object:=start
  7654.     end;
  7655.  
  7656.  
  7657. function TApplication.ini_field(tree: PTree; start: integer): integer;
  7658.  
  7659.     begin
  7660.         if start=0 then start:=find_object(tree,0,FMD_FORWARD);
  7661.         ini_field:=start
  7662.     end;
  7663.  
  7664.  
  7665. function TApplication.form_keybd(fo_ktree: PTree; fo_kobject,fo_kobnext,fo_kchar: integer; var fo_knxtobject,fo_knxtchar: integer): integer;
  7666.  
  7667.     begin
  7668.         form_keybd:=1;
  7669.         fo_knxtchar:=0;
  7670.         case fo_kchar of
  7671.             Tab: if (Kbshift(-1) and (K_LSHIFT or K_RSHIFT))>0 then fo_knxtobject:=find_object(fo_ktree,fo_kobject,FMD_BACKWARD)
  7672.                      else
  7673.                          fo_knxtobject:=find_object(fo_ktree,fo_kobject,FMD_FORWARD);
  7674.             Return,Enter: begin
  7675.                                             fo_knxtobject:=find_object(fo_ktree,-1,FMD_DEFLT);
  7676.                                             if fo_knxtobject=-1 then fo_knxtobject:=fo_kobject
  7677.                                             else
  7678.                                                 form_keybd:=0
  7679.                                         end;
  7680.             Cur_Up:   fo_knxtobject:=find_object(fo_ktree,fo_kobject,FMD_BACKWARD);
  7681.             Cur_Down: fo_knxtobject:=find_object(fo_ktree,fo_kobject,FMD_FORWARD);
  7682.             Shift_Home: fo_knxtobject:=find_object(fo_ktree,ini_field(fo_ktree,0),FMD_BACKWARD);
  7683.             Home: fo_knxtobject:=ini_field(fo_ktree,0)
  7684.         else
  7685.             begin
  7686.                 fo_knxtobject:=fo_kobject;
  7687.                 fo_knxtchar:=fo_kchar
  7688.             end
  7689.         end;
  7690.     end;
  7691.  
  7692.  
  7693. function TApplication.form_button(pd: PDialog; fo_bobject,fo_bclicks: integer; var fo_bnxtobj: integer): boolean;
  7694.     label _raus;
  7695.  
  7696.     var obs,obf,robj,dummy,bx,by: integer;
  7697.         brect,mrect             : GRECT;
  7698.         onbtn,inrect,visible    : boolean;
  7699.  
  7700.     begin
  7701.         form_button:=true;
  7702.         fo_bnxtobj:=0;
  7703.         obs:=pd^.DlgTree^[fo_bobject].ob_state;
  7704.         obf:=pd^.DlgTree^[fo_bobject].ob_flags;
  7705.         if bTst(obs,DISABLED) or bTst(obf,HIDETREE) then exit;
  7706.         wind_update(BEG_UPDATE);
  7707.         wind_update(BEG_MCTRL);
  7708.         if bTst(obf,SELECTABLE) then
  7709.             begin
  7710.                 if bTst(obf,RBUTTON) then
  7711.                     begin
  7712.                         if not(bTst(obs,SELECTED)) then
  7713.                             begin
  7714.                                 robj:=fo_bobject;
  7715.                                 repeat
  7716.                                     dummy:=pd^.DlgTree^[robj].ob_next;
  7717.                                     if pd^.DlgTree^[dummy].ob_tail=robj then
  7718.                                         robj:=pd^.DlgTree^[dummy].ob_head
  7719.                                     else
  7720.                                         robj:=dummy;
  7721.                                     if bTst(pd^.DlgTree^[robj].ob_state,SELECTED) then
  7722.                                         begin
  7723.                                             objc_change(pd^.DlgTree,robj,0,0,0,1,1,pd^.DlgTree^[robj].ob_state and not(SELECTED),1);
  7724.                                             pd^.ObjcPaint(robj,false)
  7725.                                         end;
  7726.                                 until robj=fo_bobject;
  7727.                                 objc_change(pd^.DlgTree,fo_bobject,0,0,0,1,1,obs or SELECTED,1);
  7728.                                 pd^.ObjcPaint(fo_bobject,false);
  7729.                                 repeat
  7730.                                     graf_mkstate(dummy,dummy,robj,dummy)
  7731.                                 until not(bTst(robj,1))
  7732.                             end
  7733.                     end
  7734.                 else
  7735.                     if bTst(obf,F_EXIT) then
  7736.                         begin
  7737.                             obs:=obs or SELECTED;
  7738.                             objc_change(pd^.DlgTree,fo_bobject,0,0,0,1,1,obs,1);
  7739.                             pd^.ObjcPaint(fo_bobject,false);
  7740.                             objc_offset(pd^.DlgTree,fo_bobject,bx,by);
  7741.                             with brect do
  7742.                                 begin
  7743.                                     X:=bx;
  7744.                                     Y:=by;
  7745.                                     W:=pd^.DlgTree^[fo_bobject].ob_width;
  7746.                                     H:=pd^.DlgTree^[fo_bobject].ob_height
  7747.                                 end;
  7748.                             onbtn:=true;
  7749.                             repeat
  7750.                                 graf_mkstate(bx,by,robj,dummy);
  7751.                                 if pd^.IsModal then
  7752.                                     inrect:=((bx>=brect.X) and (by>=brect.Y) and (bx<brect.X+brect.W) and (by<brect.Y+brect.H))
  7753.                                 else
  7754.                                     begin
  7755.                                         inrect:=false;
  7756.                                         visible:=pd^.FirstWorkRect(mrect);
  7757.                                         while visible do
  7758.                                             begin
  7759.                                                 if rc_intersect(brect,mrect) then
  7760.                                                     with mrect do
  7761.                                                         if (bx>=X1) and (by>=Y1) and (bx<=X2) and (by<=Y2) then inrect:=true;
  7762.                                                 visible:=pd^.NextWorkRect(mrect)
  7763.                                             end
  7764.                                     end;
  7765.                                 if inrect<>onbtn then
  7766.                                     begin
  7767.                                         obs:=obs xor SELECTED;
  7768.                                         objc_change(pd^.DlgTree,fo_bobject,0,0,0,1,1,obs,1);
  7769.                                         pd^.ObjcPaint(fo_bobject,false);
  7770.                                         onbtn:=inrect
  7771.                                     end
  7772.                             until not(bTst(robj,1));
  7773.                             if not(onbtn) then goto _raus
  7774.                         end
  7775.                     else
  7776.                         begin
  7777.                             objc_change(pd^.DlgTree,fo_bobject,0,0,0,1,1,obs xor SELECTED,1);
  7778.                             pd^.ObjcPaint(fo_bobject,false);
  7779.                             if not(bTst(obf,TOUCHEXIT)) then
  7780.                                 repeat
  7781.                                     graf_mkstate(dummy,dummy,robj,dummy)
  7782.                                 until not(bTst(robj,1))
  7783.                         end
  7784.             end;
  7785.         if (obf and (F_EXIT or TOUCHEXIT or EDITABLE))>0 then
  7786.             begin
  7787.                 fo_bnxtobj:=fo_bobject;
  7788.                 if (obf and (F_EXIT or TOUCHEXIT))>0 then form_button:=false;
  7789.                 if bTst(obf,TOUCHEXIT) and (fo_bclicks>1) then fo_bnxtobj:=fo_bnxtobj or $8000
  7790.             end;
  7791.         _raus:
  7792.         wind_update(END_MCTRL);
  7793.         wind_update(END_UPDATE)
  7794.     end;
  7795.  
  7796.  
  7797. procedure TApplication.GOErrAlert(sign: integer; msg: string);
  7798.  
  7799.     begin
  7800.         Alert(nil,1,sign,'"'+StrPLeft(StrPTrimF(Name^),26)+'":|'+msg,'  &OK  ')
  7801.     end;
  7802.  
  7803.  
  7804. function TApplication.XAccMR2HR(MR: string): string;
  7805.     label _raus;
  7806.  
  7807.     const txt : array [0..25] of string[28] =
  7808.            ('word processor',
  7809.             'DTP',
  7810.             'text editor',
  7811.             'database',
  7812.             'spreadsheet',
  7813.             'raster graphics application',
  7814.             'vector graphics application',
  7815.             'general graphics application',
  7816.             'music application',
  7817.             'CAD',
  7818.             'data communication',
  7819.             'desktop',
  7820.             'programming environment',
  7821.             'Textverarbeitung',
  7822.             'DTP',
  7823.             'Texteditor',
  7824.             'Datenbank',
  7825.             'Tabellenkalkulation',
  7826.             'Rastergrafikprogramm',
  7827.             'Vektorgrafikprogramm',
  7828.             'Allgemeines Grafikprogramm',
  7829.             'Musikprogramm',
  7830.             'CAD',
  7831.             'Datenkommunikation',
  7832.             'Desktop',
  7833.             'Programmiersprache');
  7834.  
  7835.     var ret: integer;
  7836.  
  7837.     begin
  7838.         ret:=-1;
  7839.         if length(MR)<>2 then goto _raus;
  7840.         case (ord(MR[1]) shl 8)+ord(MR[2]) of
  7841.             22352: ret:=0;
  7842.             17488: ret:=1;
  7843.             17732: ret:=2;
  7844.             17474: ret:=3;
  7845.             21331: ret:=4;
  7846.             21063: ret:=5;
  7847.             22087: ret:=6;
  7848.             18247: ret:=7;
  7849.             19797: ret:=8;
  7850.             17220: ret:=9;
  7851.             17475: ret:=10;
  7852.             17492: ret:=11;
  7853.             20549: ret:=12
  7854.         end;
  7855.         if (Attr.Country=FRG) or (Attr.Country=SWG) then inc(ret,13);
  7856.         _raus:
  7857.         if ret>=0 then XAccMR2HR:=txt[ret]
  7858.         else
  7859.             XAccMR2HR:=''
  7860.     end;
  7861.  
  7862.  
  7863. function TApplication.AlertBubbleWrap(txt: string; width: integer): string;
  7864.     label _again;
  7865.  
  7866.     var ret: string;
  7867.         t  : integer;
  7868.  
  7869.     procedure add(s: string);
  7870.         label _nochmal;
  7871.  
  7872.         var i: integer;
  7873.  
  7874.         begin
  7875.             _nochmal:
  7876.             StrPTrim(s);
  7877.             if length(s)>width then
  7878.                 begin
  7879.                     i:=width;
  7880.                     while not(s[i] in [' ',',','.',';','?','!',':','-','+',')','\']) and (i>0) do dec(i);
  7881.                     if i=0 then i:=width;
  7882.                     ret:=ret+StrPTrimF(StrPLeft(s,i))+'|';
  7883.                     s:=StrPRight(s,length(s)-i);
  7884.                     goto _nochmal
  7885.                 end;
  7886.             ret:=ret+s
  7887.         end;
  7888.  
  7889.     begin
  7890.         if width<2 then width:=2;
  7891.         ret:='';
  7892.         _again:
  7893.         StrPTrim(txt);
  7894.         t:=pos('|',txt);
  7895.         if t>0 then
  7896.             begin
  7897.                 if t>width+1 then
  7898.                     begin
  7899.                         add(StrPLeft(txt,t-1));
  7900.                         ret:=ret+'|';
  7901.                         txt:=StrPRight(txt,length(txt)-t)
  7902.                     end
  7903.                 else
  7904.                     begin
  7905.                         ret:=ret+StrPTrimF(StrPLeft(txt,t-1))+'|';
  7906.                         txt:=StrPRight(txt,length(txt)-t)
  7907.                     end;
  7908.                 goto _again
  7909.             end;
  7910.         add(txt);
  7911.         AlertBubbleWrap:=ret
  7912.     end;
  7913.  
  7914.  
  7915. procedure    TApplication.FixResource(raddr: pointer; mode,what: boolean);
  7916.     label _bitblks;
  7917.  
  7918.     var rsf           : PRsFile;
  7919.         rsh           : RSHDRPtr;
  7920.         tree          : PTree;
  7921.         pool          : AESTreePtrArrayPtr;
  7922.         tedinfo       : TedinfoArrayPtr;
  7923.         iconblk       : IconBlockArrayPtr;
  7924.         bitblk        : BitBlockArrayPtr;
  7925.         fstrpool      : FreeStrPtrArrayPtr;
  7926.         fimgpool      : FreeImgPtrArrayPtr;
  7927.         obj,objCnt,typ: integer;
  7928.         offset        : longint;
  7929.         theMFDB       : MFDB;
  7930.         taddr         : pointer;
  7931.  
  7932.     procedure    AbsToRelCoords(var coord: integer; defCharSize: integer);
  7933.  
  7934.         begin
  7935.             coord:=((coord mod defCharSize) shl 8)+(coord div defCharSize)
  7936.         end;
  7937.  
  7938.     procedure    RelToAbsCoords(var coord: integer; defCharSize: integer);
  7939.  
  7940.         begin
  7941.             coord:=((coord and $ff)*defCharSize)+(coord shr 8)
  7942.         end;
  7943.  
  7944.     procedure FixBitBlks;
  7945.         var obj: integer;
  7946.  
  7947.         begin
  7948.             if rsh^.rsh_nib>0 then
  7949.                 for obj:=0 to rsh^.rsh_nib-1 do
  7950.                     with iconblk^[obj] do
  7951.                         begin
  7952.                             taddr:=ib_pdata;
  7953.                             if taddr<>nil then
  7954.                                 begin
  7955.                                     vdi_fix(theMFDB,taddr,ib_wicon,ib_hicon);
  7956.                                     vr_convert(vdiHandle,theMFDB,FF_DEVSPEC)
  7957.                                 end;
  7958.                             taddr:=ib_pmask;
  7959.                             if taddr<>nil then
  7960.                                 begin
  7961.                                     vdi_fix(theMFDB,taddr,ib_wicon,ib_hicon);
  7962.                                     vr_convert(vdiHandle,theMFDB,FF_DEVSPEC)
  7963.                                 end
  7964.                         end;
  7965.             if rsh^.rsh_nbb>0 then
  7966.                 for obj:=0 to rsh^.rsh_nbb-1 do
  7967.                     with bitblk^[obj] do
  7968.                         begin
  7969.                             taddr:=bi_pdata;
  7970.                             if taddr<>nil then
  7971.                                 begin
  7972.                                     vdi_fix(theMFDB,taddr,bi_wb shl 3,bi_hl);
  7973.                                     vr_convert(vdiHandle,theMFDB,FF_DEVSPEC)
  7974.                                 end
  7975.                         end
  7976.         end;
  7977.  
  7978.     procedure UnfixBitBlks;
  7979.         var obj: integer;
  7980.  
  7981.         begin
  7982.             if rsh^.rsh_nib>0 then
  7983.                 for obj:=0 to rsh^.rsh_nib-1 do
  7984.                     with iconblk^[obj] do
  7985.                         begin
  7986.                             taddr:=ib_pdata;
  7987.                             if taddr<>nil then
  7988.                                 begin
  7989.                                     vdi_fix(theMFDB,taddr,ib_wicon,ib_hicon);
  7990.                                     theMFDB.fd_stand:=FF_DEVSPEC;
  7991.                                     vr_convert(vdiHandle,theMFDB,FF_STAND)
  7992.                                 end;
  7993.                             taddr:=ib_pmask;
  7994.                             if taddr<>nil then
  7995.                                 begin
  7996.                                     vdi_fix(theMFDB,taddr,ib_wicon,ib_hicon);
  7997.                                     theMFDB.fd_stand:=FF_DEVSPEC;
  7998.                                     vr_convert(vdiHandle,theMFDB,FF_STAND)
  7999.                                 end
  8000.                         end;
  8001.             if rsh^.rsh_nbb>0 then
  8002.                 for obj:=0 to rsh^.rsh_nbb-1 do
  8003.                     with bitblk^[obj] do
  8004.                         begin
  8005.                             taddr:=bi_pdata;
  8006.                             if taddr<>nil then
  8007.                                 begin
  8008.                                     vdi_fix(theMFDB,taddr,bi_wb shl 3,bi_hl);
  8009.                                     theMFDB.fd_stand:=FF_DEVSPEC;
  8010.                                     vr_convert(vdiHandle,theMFDB,FF_STAND)
  8011.                                 end
  8012.                         end
  8013.         end;
  8014.  
  8015.     begin
  8016.         offset:=longint(raddr);
  8017.         rsf:=raddr;
  8018.         rsh:=@rsf^.rsh;
  8019.         tree:=@rsf^.rsd[rsh^.rsh_object];
  8020.         tedinfo:=@rsf^.rsd[rsh^.rsh_tedinfo];
  8021.         iconblk:=@rsf^.rsd[rsh^.rsh_iconblk];
  8022.         bitblk:=@rsf^.rsd[rsh^.rsh_bitblk];
  8023.         pool:=@rsf^.rsd[rsh^.rsh_trindex];
  8024.         fstrpool:=@rsf^.rsd[rsh^.rsh_frstr];
  8025.         fimgpool:=@rsf^.rsd[rsh^.rsh_frimg];
  8026.         if mode=UNFIXRSC then
  8027.             begin
  8028.                 offset:=-offset;
  8029.                 UnfixBitBlks
  8030.             end;
  8031.         if what=FIX_BBONLY then goto _bitblks;
  8032.         if rsh^.rsh_nobs>0 then
  8033.             for obj:=0 to rsh^.rsh_nobs-1 do
  8034.                 with tree^[obj] do
  8035.                     begin
  8036.                         if mode=FIXRSC then
  8037.                             begin
  8038.                                 RelToAbsCoords(ob_x,Attr.charSWidth);
  8039.                                 RelToAbsCoords(ob_y,Attr.charSHeight);
  8040.                                 RelToAbsCoords(ob_width,Attr.charSWidth);
  8041.                                 RelToAbsCoords(ob_height,Attr.charSHeight);
  8042.                             end
  8043.                         else
  8044.                             begin
  8045.                                 AbsToRelCoords(ob_x,Attr.charSWidth);
  8046.                                 AbsToRelCoords(ob_y,Attr.charSHeight);
  8047.                                 AbsToRelCoords(ob_width,Attr.charSWidth);
  8048.                                 AbsToRelCoords(ob_height,Attr.charSHeight);
  8049.                             end;
  8050.                         typ:=ob_type and $ff;
  8051.                         if (typ=G_TEXT) or (typ=G_BOXTEXT) or (typ=G_FTEXT) or
  8052.                            (typ=G_FBOXTEXT) or (typ=G_BUTTON) or (typ=G_STRING) or
  8053.                            (typ=G_TITLE ) or (typ=G_ICON) or (typ=G_IMAGE) then inc(ob_spec.index,offset)
  8054.                     end;
  8055.         if rsh^.rsh_nted>0 then
  8056.             for obj:=0 to rsh^.rsh_nted-1 do
  8057.                 with tedinfo^[obj] do
  8058.                     begin
  8059.                         inc(longint(te_ptext),offset);
  8060.                         inc(longint(te_ptmplt),offset);
  8061.                         inc(longint(te_pvalid),offset)
  8062.                     end;
  8063.         if rsh^.rsh_nib>0 then
  8064.             for obj:=0 to rsh^.rsh_nib-1 do
  8065.                 with iconblk^[obj] do
  8066.                     begin
  8067.                         inc(longint(ib_pmask),offset);
  8068.                         inc(longint(ib_pdata),offset);
  8069.                         inc(longint(ib_ptext),offset)
  8070.                     end;
  8071.         if rsh^.rsh_nbb>0 then
  8072.             for obj:=0 to rsh^.rsh_nbb-1 do inc(longint(bitblk^[obj].bi_pdata),offset);
  8073.         if rsh^.rsh_ntree>0 then
  8074.             for obj:=0 to rsh^.rsh_ntree-1 do inc(longint(pool^[obj]),offset);
  8075.         if rsh^.rsh_nstring>0 then
  8076.             for obj:=0 to rsh^.rsh_nstring-1 do inc(longint(fstrpool^[obj]),offset);
  8077.         if rsh^.rsh_nimages>0 then
  8078.             for obj:=0 to rsh^.rsh_nimages-1 do inc(longint(fimgpool^[obj]),offset);
  8079.         _bitblks:
  8080.         if mode=FIXRSC then FixBitBlks
  8081.     end;
  8082.  
  8083.  
  8084. function TApplication.MenuCorrect: boolean;
  8085.     var i,abs_x,abs_y: integer;
  8086.  
  8087.     begin
  8088.         if (MenuTree^[MenuTree^[2].ob_tail].ob_x+
  8089.             MenuTree^[MenuTree^[2].ob_tail].ob_width+MenuTree^[2].ob_x)>(DRect.X+DRect.W) then MenuCorrect:=false
  8090.         else
  8091.             begin
  8092.                 i:=MenuTree^[2].ob_tail+2;
  8093.                 repeat
  8094.                     inc(i);
  8095.                     with MenuTree^[i] do
  8096.                         if ((ob_type and $ff)=G_BOX) then
  8097.                             begin
  8098.                                 if ((ob_width>=DRect.W) or (ob_height>=DRect.H)) then
  8099.                                     begin
  8100.                                         MenuCorrect:=false;
  8101.                                         exit
  8102.                                     end;
  8103.                                 objc_offset(MenuTree,i,abs_x,abs_y);
  8104.                                 if (abs_x>=(DRect.X+DRect.W-ob_width)) then
  8105.                                     dec(ob_x,abs_x+1-(DRect.X+DRect.W-ob_width))
  8106.                             end
  8107.                 until bTst(MenuTree^[i].ob_flags,LASTOB);
  8108.                 MenuTree^[ROOT].ob_width:=Attr.MaxPX+1;
  8109.                 MenuTree^[1].ob_width:=MenuTree^[ROOT].ob_width;
  8110.                 MenuCorrect:=true
  8111.             end
  8112.     end;
  8113.  
  8114.  
  8115. procedure TApplication.MenuTune;
  8116.     var i: integer;
  8117.  
  8118.     begin
  8119.         i:=-1;
  8120.         mnusr.ub_parm:=0;
  8121.         mnusr.ub_code:=@DrawMenuRect;
  8122.         repeat
  8123.             inc(i);
  8124.             with MenuTree^[i] do
  8125.                 if ((ob_type and $ff)=G_STRING) then
  8126.                     if bTst(ob_state,DISABLED) and (PChar(ob_spec.free_string)^='-') then
  8127.                         begin
  8128.                             ob_type:=G_USERDEF;
  8129.                             ob_spec.user_blk:=@mnusr
  8130.                         end
  8131.         until bTst(MenuTree^[i].ob_flags,LASTOB)
  8132.     end;
  8133.  
  8134. { *** TAPPLICATION *** }
  8135.  
  8136.  
  8137.  
  8138. { *** Objekt TDIALOG *** }
  8139.  
  8140. constructor TDialog.Init(AParent: PWindow; ATitle: string; Indx: integer);
  8141.  
  8142.     begin
  8143.         if not(inherited Init(AParent,ATitle)) then fail;
  8144.         DisableAutoCreate;
  8145.         if Indx<>id_No then
  8146.             begin
  8147.                 Application^.ChkError;
  8148.                 LoadDialog(Indx);
  8149.                 if Application^.Err<em_OK then
  8150.                     begin
  8151.                         inherited Done;
  8152.                         fail
  8153.                     end;
  8154.                 SetupSize
  8155.             end
  8156.     end;
  8157.  
  8158.  
  8159. destructor TDialog.Done;
  8160.     var dummy: integer;
  8161.  
  8162.     begin
  8163.         edit_obj:=0;
  8164.         next_obj:=0;
  8165.         Cont:=false;
  8166.         pedt:=nil;
  8167.         while (CtrlList<>nil) do CtrlList^.Free;
  8168.         inherited Done
  8169.     end;
  8170.  
  8171.  
  8172. function TDialog.GetStyle: integer;
  8173.     var ret: integer;
  8174.  
  8175.     begin
  8176.         ret:=NAME or CLOSER or MOVER;
  8177.         if GEMVersion>=$0410 then
  8178.             begin
  8179.                 if TOSVersion=$0492 then ret:=ret or $1000
  8180.                 else
  8181.                     ret:=ret or SMALLER
  8182.             end;
  8183.         GetStyle:=ret
  8184.     end;
  8185.  
  8186.  
  8187. procedure TDialog.GetWindowClass(var AWndClass: TWndClass);
  8188.  
  8189.     begin
  8190.         inherited GetWindowClass(AWndClass);
  8191.         with AWndClass do
  8192.             Style:=(Style and not(cs_CreateOnAccOpen)) or cs_SaveBits or cs_WorkBackground
  8193.     end;
  8194.  
  8195.  
  8196. function TDialog.GetClassName: string;
  8197.  
  8198.     begin
  8199.         GetClassName:='Dialog'
  8200.     end;
  8201.  
  8202.  
  8203. function TDialog.GetKBHandler: PEvent;
  8204.  
  8205.     begin
  8206.         GetKBHandler:=kbdh
  8207.     end;
  8208.  
  8209.  
  8210. function TDialog.IsDialog: boolean;
  8211.  
  8212.     begin
  8213.         IsDialog:=true
  8214.     end;
  8215.  
  8216.  
  8217. procedure TDialog.LoadDialog(Indx: integer);
  8218.     var tp   : PTree;
  8219.         valid: boolean;
  8220.  
  8221.     function GetDPWindow: PWindow;
  8222.         var p,pc,pc2: PWindow;
  8223.  
  8224.         begin
  8225.             p:=Application^.MainWindow;
  8226.             while (p<>nil) do
  8227.                 begin
  8228.                     if (p^.DlgTree=tp) or (p^.Class.ToolbarTree=tp) then
  8229.                         begin
  8230.                             GetDPWindow:=p;
  8231.                             exit
  8232.                         end;
  8233.                     pc:=p^.ChildList;
  8234.                     if (pc<>nil) then
  8235.                         begin
  8236.                             while (pc^.ChildList<>nil) do pc:=pc^.ChildList;
  8237.                             repeat
  8238.                                 pc2:=pc;
  8239.                                 while (pc2<>nil) do
  8240.                                     with pc2^ do
  8241.                                         begin
  8242.                                             if (DlgTree=tp) or (Class.ToolbarTree=tp) then
  8243.                                                 begin
  8244.                                                     GetDPWindow:=pc2;
  8245.                                                     exit
  8246.                                                 end;
  8247.                                             pc2:=Nxt
  8248.                                         end;
  8249.                                 pc:=pc^.Parent
  8250.                             until pc=p
  8251.                         end;
  8252.                     p:=p^.Nxt
  8253.                 end;
  8254.             GetDPWindow:=nil
  8255.         end;
  8256.  
  8257.     begin
  8258.         valid:=false;
  8259.         tp:=Application^.GetAddr(Indx);
  8260.         if tp<>nil then valid:=(GetDPWindow=nil);
  8261.         if valid then inherited LoadDialog(Indx)
  8262.         else
  8263.             Application^.Err:=em_InvalidDialog
  8264.     end;
  8265.  
  8266.  
  8267. procedure TDialog.UpdateDialog;
  8268.  
  8269.     begin
  8270.         if IsModal then Work:=Curr;
  8271.         inherited UpdateDialog
  8272.     end;
  8273.  
  8274.  
  8275. procedure TDialog.SetupSize;
  8276.     var wmw,wmh: integer;
  8277.         r      : GRECT;
  8278.  
  8279.     begin
  8280.         inherited SetupSize;
  8281.         with DlgTree^[ROOT] do
  8282.             begin
  8283.                 Work.W:=ob_width;
  8284.                 Work.H:=ob_height
  8285.             end;
  8286.         wmaxw:=Work.W;
  8287.         wmaxh:=Work.H;
  8288.         GetWorkMax(wmw,wmh);
  8289.         if (wmw>wmaxw) or (wmh>wmaxh) then
  8290.             begin
  8291.                 Calc(WC_WORK,DRect,r);
  8292.                 if wmw>wmaxw then Work.W:=Min(wmw,r.W);
  8293.                 if wmh>wmaxh then Work.H:=Min(wmh,r.H)
  8294.             end;
  8295.         Calc(WC_BORDER,Work,Curr)
  8296.     end;
  8297.  
  8298.  
  8299. procedure TDialog.SetupWindow;
  8300.     var pipe: Pipearray;
  8301.  
  8302.     begin
  8303.         Attr.ExStyle:=ws_ex_TryModeless or ws_ex_CenterOnce;
  8304.         if bTst(Application^.Attr.Style,as_MoveTransparent) then
  8305.             Attr.ExStyle:=Attr.ExStyle or ws_ex_MoveTransparent
  8306.         else
  8307.             if bTst(Application^.Attr.Style,as_MoveDials) then
  8308.                 Attr.ExStyle:=Attr.ExStyle or ws_ex_MoveDial;
  8309.         edit_obj:=0;
  8310.         next_obj:=0;
  8311.         Cont:=false;
  8312.         pedt:=nil;
  8313.         BValid:=false;
  8314.         CtrlList:=nil;
  8315.         TransferBuffer:=nil;
  8316.         bsave:=true;
  8317.         d0fly:=false;
  8318.         obedflag:=false;
  8319.         IsModal:=false;
  8320.         if Parent<>nil then
  8321.             if Parent^.IsDialog then IsModal:=PDialog(Parent)^.IsModal;
  8322.         pipe[0]:=WM_BOTTOMED;
  8323.         new(PKey,Init(@self,K_CTRL,Ctrl_Backdrop,@pipe,true));
  8324.         pipe[0]:=WM_CLOSED;
  8325.         new(PFUKey,Init(@self,K_CTRL,Ctrl_U,@pipe,true));
  8326.         pipe[0]:=WM_FULLED;
  8327.         new(PFUKey,Init(@self,K_CTRL,Ctrl_Fuller,@pipe,true));
  8328.         new(PWKey,Init(@self,-1,-1,nil,false));
  8329.         new(PIKey,Init(@self,K_CTRL,Ctrl_Iconify,nil,false));
  8330.         kbdh:=new(PDKey,Init(@self))
  8331.     end;
  8332.  
  8333.  
  8334. procedure TDialog.MakeWindow;
  8335.  
  8336.     begin
  8337.         Create;
  8338.         OpenWindow;
  8339.         if (IsModal) and (Application^.Err>=em_OutOfMemory) then Execute
  8340.     end;
  8341.  
  8342.  
  8343. procedure TDialog.Create;
  8344.     var r : GRECT;
  8345.         vp: INFOVSCRPtr;
  8346.  
  8347.     begin
  8348.         if Attr.Status=ws_NoWindow then
  8349.             begin
  8350.                 if not(IsModal) then IsModal:=not(bTst(Attr.ExStyle,ws_ex_Modeless));
  8351.                 if IsModal then Attr.Status:=ws_Created
  8352.                 else
  8353.                     begin
  8354.                         Application^.ChkError;
  8355.                         inherited Create;
  8356.                         if Application^.Err<em_OutOfMemory then
  8357.                             if bTst(Attr.ExStyle,ws_ex_TryModeless) then
  8358.                                 begin
  8359.                                     Application^.ChkError;
  8360.                                     Attr.Status:=ws_Created;
  8361.                                     IsModal:=true
  8362.                                 end
  8363.                     end;
  8364.                 if Attr.Status=ws_Created then
  8365.                     begin
  8366.                         with DlgTree^[ROOT] do
  8367.                             begin
  8368.                                 if bTst(Application^.Attr.Style,as_3DFlags) then ob_flags:=ob_flags or FL3DBAK
  8369.                                 else
  8370.                                     ob_flags:=ob_flags and not(FL3DBAK);
  8371.                                 if IsModal then
  8372.                                     begin
  8373.                                         ob_state:=ob_state or OUTLINED;
  8374.                                         Work.W:=ob_width+outlwidth*2;
  8375.                                         Work.H:=ob_height+outlwidth*2;
  8376.                                         wmaxw:=Work.W;
  8377.                                         wmaxh:=Work.H;
  8378.                                         Curr:=Work
  8379.                                     end
  8380.                                 else
  8381.                                     begin
  8382.                                         ob_state:=ob_state and not(OUTLINED);
  8383.                                         frwid:=ob_spec.index and $00ff0000;
  8384.                                         ob_spec.index:=(ob_spec.index and $ff00ffff) or $00010000
  8385.                                     end
  8386.                             end;
  8387.                         r:=DRect;
  8388.                         if bTst(Attr.ExStyle,ws_ex_Center) then
  8389.                             begin
  8390.                                 if GetCookie('VSCR',longint(vp)) then
  8391.                                     if vp<>nil then
  8392.                                         with vp^ do
  8393.                                             if (cookie=$56534352) and (version>=$0100) then
  8394.                                                 begin
  8395.                                                     r.X:=x;
  8396.                                                     r.Y:=y;
  8397.                                                     r.W:=w;
  8398.                                                     r.H:=h
  8399.                                                 end;
  8400.                                 if bTst(Attr.ExStyle,ws_ex_Center2Parent) then
  8401.                                     if Parent<>nil then
  8402.                                         with Parent^ do
  8403.                                             if Attr.Status=ws_Open then
  8404.                                                 begin
  8405.                                                     r.X:=Curr.X;
  8406.                                                     r.Y:=Curr.Y;
  8407.                                                     r.W:=Curr.W;
  8408.                                                     r.H:=Curr.H
  8409.                                                 end;
  8410.                                 Curr.X:=((r.W-Curr.W) shr 1)+r.X;
  8411.                                 Curr.Y:=((r.H-Curr.H) shr 1)+r.Y;
  8412.                                 if Curr.X+Curr.W-1>DRect.X2 then Curr.X:=DRect.X2+1-Curr.W;
  8413.                                 if Curr.Y+Curr.H-1>DRect.Y2 then Curr.Y:=DRect.Y2+1-Curr.H;
  8414.                                 if Curr.X<DRect.X1 then Curr.X:=DRect.X1;
  8415.                                 if Curr.Y<DRect.Y1 then Curr.Y:=DRect.Y1;
  8416.                                 GRtoA2(Curr);
  8417.                                 if bTst(Attr.ExStyle,ws_ex_CenterOnce) then
  8418.                                     Attr.ExStyle:=Attr.ExStyle and not(ws_ex_CenterOnce)
  8419.                             end;
  8420.                         if IsModal then CreateChildren
  8421.                     end
  8422.             end
  8423.         else
  8424.             inherited Create
  8425.     end;
  8426.  
  8427.  
  8428. procedure TDialog.OpenWindow;
  8429.     var mx,my,dummy: integer;
  8430.         p          : PWindow;
  8431.         PaintInfo  : TPaintStruct;
  8432.  
  8433.     begin
  8434.         if Attr.Status=ws_Created then
  8435.             begin
  8436.                 if bTst(Attr.ExStyle,ws_ex_Popup) then
  8437.                     begin
  8438.                         graf_mkstate(mx,my,dummy,dummy);
  8439.                         Curr.X:=mx-(Curr.W shr 1);
  8440.                         Curr.Y:=my-(Curr.H shr 1);
  8441.                         if Curr.X+Curr.W-1>DRect.X2 then Curr.X:=DRect.X2+1-Curr.W;
  8442.                         if Curr.Y+Curr.H-1>DRect.Y2 then Curr.Y:=DRect.Y2+1-Curr.H;
  8443.                         if Curr.X<DRect.X1 then Curr.X:=DRect.X1;
  8444.                         if Curr.Y<DRect.Y1 then Curr.Y:=DRect.Y1;
  8445.                         GRtoA2(Curr)
  8446.                     end;
  8447.                 pedt:=nil;
  8448.                 Cont:=true;
  8449.                 if edit_obj=0 then next_obj:=Application^.ini_field(DlgTree,0)
  8450.                 else
  8451.                     begin
  8452.                         next_obj:=edit_obj;
  8453.                         edit_obj:=0
  8454.                     end;
  8455.                 TransferData(tf_SetData);
  8456.                 if IsModal then
  8457.                     begin
  8458.                         wind_update(BEG_UPDATE);
  8459.                         wind_update(BEG_MCTRL);
  8460.                         inc(Application^.DlgTop);
  8461.                         Attr.Status:=ws_Open;
  8462.                         SaveBackground;
  8463.                         if bTst(Application^.Attr.Style,as_GrowShrink) then form_box(FMD_GROW,Curr);
  8464.                         with PaintInfo do
  8465.                             begin
  8466.                                 fErase:=false;
  8467.                                 rcPaint:=Curr
  8468.                             end;
  8469.                         HideMouse;
  8470.                         UpdateDialog;
  8471.                         InitPaint;
  8472.                         Paint(PaintInfo);
  8473.                         ExitPaint;
  8474.                         ShowMouse;
  8475.                         p:=ChildList;
  8476.                         while (p<>nil) do
  8477.                             with p^ do
  8478.                                 begin
  8479.                                     OpenWindow;
  8480.                                     p:=Nxt
  8481.                                 end
  8482.                     end
  8483.                 else
  8484.                     inherited OpenWindow
  8485.             end
  8486.         else
  8487.             inherited OpenWindow
  8488.     end;
  8489.  
  8490.  
  8491. procedure TDialog.CloseWindow;
  8492.     var p    : PWindow;
  8493.         dummy: integer;
  8494.  
  8495.     begin
  8496.         p:=ChildList;
  8497.         while (p<>nil) do
  8498.             with p^ do
  8499.                 begin
  8500.                     CloseWindow;
  8501.                     p:=Nxt
  8502.                 end;
  8503.         if Attr.Status=ws_Open then
  8504.             begin
  8505.                 if edit_obj>0 then
  8506.                     begin
  8507.                         objc_edit(dummy,EDEND,Work.A2,true);
  8508.                         next_obj:=0;
  8509.                         Cont:=false;
  8510.                         pedt:=nil
  8511.                     end;
  8512.                 if IsModal then
  8513.                     begin
  8514.                         if bTst(Application^.Attr.Style,as_GrowShrink) then form_box(FMD_SHRINK,Curr);
  8515.                         RestoreBackground;
  8516.                         dec(Application^.DlgTop);
  8517.                         Attr.Status:=ws_Created;
  8518.                         wind_update(END_MCTRL);
  8519.                         wind_update(END_UPDATE)
  8520.                     end
  8521.                 else
  8522.                     inherited CloseWindow
  8523.             end
  8524.     end;
  8525.  
  8526.  
  8527. procedure TDialog.Destroy;
  8528.     var p    : PWindow;
  8529.         dummy: integer;
  8530.  
  8531.     begin
  8532.         p:=ChildList;
  8533.         while (p<>nil) do
  8534.             with p^ do
  8535.                 begin
  8536.                     Destroy;
  8537.                     p:=Nxt
  8538.                 end;
  8539.         if Attr.Status in [ws_Created,ws_Open] then
  8540.             begin
  8541.                 if IsModal then
  8542.                     begin
  8543.                         CloseWindow;
  8544.                         IsModal:=false;
  8545.                         Attr.Status:=ws_NoWindow
  8546.                     end
  8547.                 else
  8548.                     begin
  8549.                         with DlgTree^[ROOT] do
  8550.                             ob_spec.index:=ob_spec.index or frwid;
  8551.                         inherited Destroy
  8552.                     end
  8553.             end
  8554.     end;
  8555.  
  8556.  
  8557. procedure TDialog.Paint(var PaintInfo: TPaintStruct);
  8558.     var dummy: integer;
  8559.  
  8560.     begin
  8561.         with PaintInfo.rcPaint do objc_draw(DlgTree,ROOT,MAX_DEPTH,X,Y,W,H);
  8562.         if (next_obj>0) and (edit_obj<>next_obj) then
  8563.             begin
  8564.                 edit_obj:=next_obj;
  8565.                 next_obj:=0;
  8566.                 CallChanged(edit_obj,false,true,false);
  8567.                 objc_edit(dummy,EDINIT,PaintInfo.rcPaint.A2,false)
  8568.             end
  8569.         else
  8570.             if edit_obj>0 then
  8571.                 objc_edit(dummy,EDDRAW,PaintInfo.rcPaint.A2,false)
  8572.     end;
  8573.  
  8574.  
  8575. procedure TDialog.ObjcPaint(Indx: integer; Lazy: boolean);
  8576.     label _weiter;
  8577.  
  8578.     var box    : GRECT;
  8579.         visible: boolean;
  8580.  
  8581.     begin
  8582.         if Attr.Status=ws_Open then
  8583.             if not(IsIconified) then
  8584.                 begin
  8585.                     if IsModal then
  8586.                         begin
  8587.                             HideMouse;
  8588.                             with DRect do objc_draw(DlgTree,Indx,MAX_DEPTH,X,Y,W,H);
  8589.                             ShowMouse
  8590.                         end
  8591.                     else
  8592.                         begin
  8593.                             if Lazy then
  8594.                                 if GEMVersion>=$0400 then
  8595.                                     begin
  8596.                                         if wind_update(TEST_BEG_UPDATE)=0 then exit
  8597.                                         else
  8598.                                             goto _weiter
  8599.                                     end;
  8600.                             wind_update(BEG_UPDATE);
  8601.                             _weiter:
  8602.                             HideMouse;
  8603.                             visible:=FirstWorkRect(box);
  8604.                             while visible do
  8605.                                 begin
  8606.                                     with box do objc_draw(DlgTree,Indx,MAX_DEPTH,X,Y,W,H);
  8607.                                     visible:=NextWorkRect(box)
  8608.                                 end;
  8609.                             ShowMouse;
  8610.                             wind_update(END_UPDATE)
  8611.                         end
  8612.                 end
  8613.     end;
  8614.  
  8615.  
  8616. procedure TDialog.GetWorkMax(var maxX,maxY: integer);
  8617.  
  8618.     begin
  8619.         maxX:=wmaxw;
  8620.         maxY:=wmaxh
  8621.     end;
  8622.  
  8623.  
  8624. procedure TDialog.WMClosed;
  8625.     var valid   : boolean;
  8626.         tst,indx: integer;
  8627.         p       : PControl;
  8628.  
  8629.     begin
  8630.         if bTst(Class.Style,cs_CancelOnClose) then tst:=id_Cancel
  8631.         else
  8632.             tst:=id_OK;
  8633.         p:=CtrlList;
  8634.         indx:=-1;
  8635.         while p<>nil do
  8636.             begin
  8637.                 if p^.TestID(tst) then
  8638.                     begin
  8639.                         indx:=p^.ObjIndx;
  8640.                         break
  8641.                     end;
  8642.                 p:=p^.Nxt
  8643.             end;
  8644.         if indx>=0 then
  8645.             begin
  8646.                 if p^.GetState<>bf_Enabled then exit;
  8647.                 if bTst(DlgTree^[indx].ob_flags,SELECTABLE) then
  8648.                     begin
  8649.                         DlgTree^[indx].ob_state:=DlgTree^[indx].ob_state or SELECTED;
  8650.                         ObjcPaint(indx,false)
  8651.                     end
  8652.             end;
  8653.         valid:=false;
  8654.         if CanClose then
  8655.             begin
  8656.                 if tst=id_Cancel then valid:=Cancel
  8657.                 else
  8658.                     valid:=OK
  8659.             end;
  8660.         if valid then
  8661.             begin
  8662.                 if indx>=0 then
  8663.                     DlgTree^[indx].ob_state:=DlgTree^[indx].ob_state and not(SELECTED);
  8664.                 Destroy
  8665.             end
  8666.         else
  8667.             if indx>=0 then
  8668.                 begin
  8669.                     DlgTree^[indx].ob_state:=DlgTree^[indx].ob_state and not(SELECTED);
  8670.                     if bTst(DlgTree^[indx].ob_flags,SELECTABLE) then ObjcPaint(indx,false)
  8671.                 end
  8672.     end;
  8673.  
  8674.  
  8675. procedure TDialog.WMButton(mX,mY,BStat,KStat,Clicks: integer);
  8676.     label _fly;
  8677.  
  8678.     var nx,dummy: integer;
  8679.         valid   : boolean;
  8680.         pct     : PControl;
  8681.  
  8682.     begin
  8683.         nx:=objc_find(DlgTree,ROOT,MAX_DEPTH,mX,mY);
  8684.         if BStat=2 then
  8685.             if nx>-1 then
  8686.                 begin
  8687.                     valid:=false;
  8688.                     pct:=CtrlList;
  8689.                     while (pct<>nil) do
  8690.                         with pct^ do
  8691.                             begin
  8692.                                 if TestIndex(nx) then
  8693.                                     if IsHelpAvailable then valid:=true;
  8694.                                 pct:=Nxt
  8695.                             end;
  8696.                     if valid then
  8697.                         if kbdh<>nil then kbdh^.TestKey(0,S_Help)
  8698.                 end;
  8699.         if nx=-1 then
  8700.             begin
  8701.                 if IsModal then Bconout(2,BEL)
  8702.                 else
  8703.                     begin
  8704.                         if (GEMVersion>=$0400) and (Clicks=2) then Top
  8705.                         else
  8706.                             inherited WMButton(mX,mY,BStat,KStat,Clicks)
  8707.                     end;
  8708.                 exit
  8709.             end;
  8710.         if BStat<>1 then exit;
  8711.         if DlgTree^[nx].ob_flags and (SELECTABLE or DEFAULT or F_EXIT or EDITABLE or RBUTTON or TOUCHEXIT)=0 then
  8712.             begin
  8713.                 _fly:
  8714.                 if d0fly and (Clicks=1) then MoveDial(mX,mY)
  8715.                 else
  8716.                     if (GEMVersion>=$0400) and (Clicks=2) and not(IsModal) then Top;
  8717.                 exit
  8718.             end;
  8719.         if not(bTst(DlgTree^[nx].ob_state,DISABLED)) then
  8720.             begin
  8721.                 next_obj:=nx;
  8722.                 Cont:=Application^.form_button(@self,next_obj,Clicks,next_obj);
  8723.                 if not(Cont) then
  8724.                     begin
  8725.                         nx:=next_obj;
  8726.                         next_obj:=0;
  8727.                         CallChanged(word(nx) and $7fff,bTst(word(nx),$8000),false,false);
  8728.                         EndDlg(integer(word(nx) and $7fff),bTst(word(nx),$8000))
  8729.                     end
  8730.                 else
  8731.                     begin
  8732.                         if (next_obj>0) and (edit_obj<>next_obj) then
  8733.                             begin
  8734.                                 objc_edit(dummy,EDEND,Work.A2,true);
  8735.                                 edit_obj:=next_obj;
  8736.                                 next_obj:=0;
  8737.                                 CallChanged(edit_obj,false,true,false);
  8738.                                 objc_edit(dummy,EDINIT,Work.A2,true)
  8739.                             end
  8740.                         else
  8741.                             begin
  8742.                                 if next_obj<=0 then CallChanged(nx,false,false,true)
  8743.                                 else
  8744.                                     objc_edit(mX,EDIDX,Work.A2,true)
  8745.                             end
  8746.                     end
  8747.             end
  8748.         else
  8749.             goto _fly
  8750.     end;
  8751.  
  8752.  
  8753. procedure TDialog.Execute;
  8754.     var evnt,mx,my,mb,ks,kr,br: integer;
  8755.         pipe                  : Pipearray;
  8756.         gmnr                  : HCursor;
  8757.         gmform                : MFORM;
  8758.  
  8759.     begin
  8760.         if not(IsModal) then exit;
  8761.         gmnr:=GP.mnr;
  8762.         gmform:=GP.mform;
  8763.         if Class.hCursor>id_No then
  8764.             begin
  8765.                 if Class.hCursor>$7fff then graf_mouse(MFORCE or USER_DEF,pointer(Class.hCursor))
  8766.                 else
  8767.                     graf_mouse(MFORCE or Class.hCursor,nil)
  8768.             end
  8769.         else
  8770.             graf_mouse(MFORCE or ARROW,nil);
  8771.         if bTst(Attr.ExStyle,ws_ex_MoveDial) then d0fly:=true;
  8772.         while Cont do
  8773.             begin
  8774.                 if (next_obj>0) and (edit_obj<>next_obj) then
  8775.                     begin
  8776.                         edit_obj:=next_obj;
  8777.                         next_obj:=0;
  8778.                         CallChanged(edit_obj,false,true,false);
  8779.                         objc_edit(evnt,EDINIT,Work.A2,false)
  8780.                     end;
  8781.                 evnt:=evnt_multi(MU_KEYBD or MU_BUTTON,258,3,0,0,0,0,0,0,0,0,0,0,0,pipe,0,0,mx,my,mb,ks,kr,br);
  8782.                 if bTst(evnt,MU_KEYBD) then
  8783.                     if kbdh<>nil then kbdh^.TestKey(ks,kr);
  8784.                 if bTst(evnt,MU_BUTTON) then WMButton(mx,my,mb,ks,br);
  8785.                 if (next_obj>0) and (next_obj<>edit_obj) then objc_edit(evnt,EDEND,Work.A2,false)
  8786.             end;
  8787.         d0fly:=false;
  8788.         graf_mouse(gmnr,@gmform)
  8789.     end;
  8790.  
  8791.  
  8792. procedure TDialog.EndDlg(Indx: integer; DblClick: boolean);
  8793.     label _cont;
  8794.  
  8795.     var p          : PControl;
  8796.         valid,found: boolean;
  8797.  
  8798.     begin
  8799.         Result:=Indx;
  8800.         found:=false;
  8801.         valid:=true;
  8802.         p:=CtrlList;
  8803.         while (p<>nil) do
  8804.             begin
  8805.                 if p^.TestIndex(Indx) then
  8806.                     begin
  8807.                         if p^.TestID(id_OK) then
  8808.                             begin
  8809.                                 found:=true;
  8810.                                 valid:=OK
  8811.                             end;
  8812.                         if p^.TestID(id_Cancel) then
  8813.                             begin
  8814.                                 found:=true;
  8815.                                 valid:=Cancel
  8816.                             end;
  8817.                         if p^.TestID(id_Help) then
  8818.                             begin
  8819.                                 found:=true;
  8820.                                 valid:=Help
  8821.                             end;
  8822.                         if p^.TestID(id_Undo) then
  8823.                             begin
  8824.                                 found:=true;
  8825.                                 valid:=Undo
  8826.                             end;
  8827.                         if p^.TestID(id_Esc) then
  8828.                             begin
  8829.                                 found:=true;
  8830.                                 valid:=Esc
  8831.                             end;
  8832.                         if p^.TestID(id_NoExit) then
  8833.                             begin
  8834.                                 found:=true;
  8835.                                 valid:=false
  8836.                             end
  8837.                     end;
  8838.                 p:=p^.Nxt
  8839.             end;
  8840.         if not(found) then valid:=ExitDlg(Indx);
  8841.         if not(valid) then goto _cont;
  8842.         if CanClose then
  8843.             begin
  8844.                 DlgTree^[Indx].ob_state:=DlgTree^[Indx].ob_state and not(SELECTED);
  8845.                 Destroy
  8846.             end
  8847.         else
  8848.             begin
  8849.                 _cont:
  8850.                 Cont:=true;
  8851.                 DlgTree^[Indx].ob_state:=DlgTree^[Indx].ob_state and not(SELECTED);
  8852.                 if bTst(DlgTree^[Indx].ob_flags,SELECTABLE) then ObjcPaint(Indx,false)
  8853.             end
  8854.     end;
  8855.  
  8856.  
  8857. procedure TDialog.TransferData(Direction: word);
  8858.     var p : PControl;
  8859.         tp: pointer;
  8860.  
  8861.     begin
  8862.         if TransferBuffer<>nil then
  8863.             begin
  8864.                 p:=CtrlList;
  8865.                 tp:=TransferBuffer;
  8866.                 while p<>nil do
  8867.                     with p^ do
  8868.                         begin
  8869.                             if IsFlagSet(wb_Transfer) then
  8870.                                 inc(longint(tp),Transfer(tp,Direction));
  8871.                             p:=Nxt
  8872.                         end
  8873.             end
  8874.     end;
  8875.  
  8876.  
  8877. function TDialog.ExitDlg(AnIndx: integer): boolean;
  8878.  
  8879.     begin
  8880.         ExitDlg:=true
  8881.     end;
  8882.  
  8883.  
  8884. function TDialog.OK: boolean;
  8885.     var vald: boolean;
  8886.         p   : PControl;
  8887.  
  8888.     begin
  8889.         vald:=true;
  8890.         p:=CtrlList;
  8891.         while (p<>nil) and vald do
  8892.             begin
  8893.                 if bTst(p^.Style,cs_Edit) then vald:=PEdit(p)^.CanClose;
  8894.                 p:=p^.Nxt
  8895.             end;
  8896.         if vald then TransferData(tf_GetData);
  8897.         OK:=vald
  8898.     end;
  8899.  
  8900.  
  8901. function TDialog.Cancel: boolean;
  8902.  
  8903.     begin
  8904.         Cancel:=true
  8905.     end;
  8906.  
  8907.  
  8908. function TDialog.Help: boolean;
  8909.  
  8910.     begin
  8911.         Help:=false
  8912.     end;
  8913.  
  8914.  
  8915. function TDialog.Undo: boolean;
  8916.  
  8917.     begin
  8918.         Undo:=false
  8919.     end;
  8920.  
  8921.  
  8922. function TDialog.Esc: boolean;
  8923.  
  8924.     begin
  8925.         Esc:=false
  8926.     end;
  8927.  
  8928.  
  8929. function TDialog.FirstThat(Test: PIterationFunc): PControl;
  8930.     var p : PControl;
  8931.         cl: IterationFunc;
  8932.  
  8933.     begin
  8934.         FirstThat:=nil;
  8935.         p:=CtrlList;
  8936.         cl:=IterationFunc(Test);
  8937.         while p<>nil do
  8938.             begin
  8939.                 if cl(p) then
  8940.                     begin
  8941.                         FirstThat:=p;
  8942.                         exit
  8943.                     end;
  8944.                 p:=p^.Nxt
  8945.             end
  8946.     end;
  8947.  
  8948.  
  8949. procedure TDialog.ForEach(Action: PIterationProc);
  8950.     var p : PControl;
  8951.         cl: IterationProc;
  8952.  
  8953.     begin
  8954.         p:=CtrlList;
  8955.         cl:=IterationProc(Action);
  8956.         while p<>nil do
  8957.             begin
  8958.                 cl(p);
  8959.                 p:=p^.Nxt
  8960.             end
  8961.     end;
  8962.  
  8963.  
  8964. procedure TDialog.InitFocus;
  8965.     var dummy: integer;
  8966.  
  8967.     begin
  8968.         if edit_obj>0 then objc_edit(dummy,EDEND,Work.A2,true);
  8969.         edit_obj:=0;
  8970.         next_obj:=Application^.ini_field(DlgTree,0);
  8971.         if next_obj>0 then
  8972.             begin
  8973.                 edit_obj:=next_obj;
  8974.                 next_obj:=0;
  8975.                 CallChanged(edit_obj,false,true,false);
  8976.                 objc_edit(dummy,EDINIT,Work.A2,true)
  8977.             end
  8978.     end;
  8979.  
  8980.  
  8981. procedure TDialog.SetFocus(Obj: integer);
  8982.     var dummy: integer;
  8983.  
  8984.     begin
  8985.         if Obj>0 then
  8986.             begin
  8987.                 if (DlgTree^[Obj].ob_flags and (EDITABLE or HIDETREE)=EDITABLE) and not(bTst(DlgTree^[Obj].ob_state,DISABLED)) then
  8988.                     begin
  8989.                         if edit_obj>0 then objc_edit(dummy,EDEND,Work.A2,true);
  8990.                         edit_obj:=Obj;
  8991.                         next_obj:=0;
  8992.                         CallChanged(edit_obj,false,true,false);
  8993.                         objc_edit(dummy,EDINIT,Work.A2,true)
  8994.                     end
  8995.                 else
  8996.                     InitFocus
  8997.             end
  8998.         else
  8999.             InitFocus
  9000.     end;
  9001.  
  9002.  
  9003. function TDialog.GetFocus: integer;
  9004.  
  9005.     begin
  9006.         if edit_obj>0 then GetFocus:=edit_obj
  9007.         else
  9008.             GetFocus:=id_No
  9009.     end;
  9010.  
  9011.  
  9012. procedure TDialog.CallChanged(Indx: integer; dclk,edt,push: boolean);
  9013.     var p: PControl;
  9014.  
  9015.     begin
  9016.         p:=CtrlList;
  9017.         if edt then pedt:=nil;
  9018.         while (p<>nil) do
  9019.             begin
  9020.                 if p^.TestIndex(Indx) then
  9021.                     begin
  9022.                         if edt then pedt:=PEdit(p);
  9023.                         if not(bTst(p^.Style,cs_PushButton)) or not(push) then p^.Changed(Indx,dclk)
  9024.                         else
  9025.                             if bTst(p^.ObjAddr^.ob_state,SELECTED) then p^.Changed(Indx,dclk);
  9026.                         exit
  9027.                     end
  9028.                 else
  9029.                     p:=p^.Nxt
  9030.             end
  9031.     end;
  9032.  
  9033.  
  9034.     { private }
  9035.  
  9036.  
  9037. procedure TDialog.MoveDial(mX,mY: integer);
  9038.     var nx,ny,w,h: integer;
  9039.         pinfo    : TPaintStruct;
  9040.         fmf      : word;
  9041.  
  9042.     begin
  9043.         if bTst(Attr.ExStyle,ws_ex_MoveTransparent) then RestoreBackground;
  9044.         fmf:=FLAT_HAND;
  9045.         if Application^.MultiTOS then fmf:=fmf or MFORCE;
  9046.         gem.graf_mouse(fmf,nil);
  9047.         graf_dragbox(Curr.W,Curr.H,Curr.X,Curr.Y,DRect.X,DRect.Y,DRect.W+Curr.X+Curr.W-mX-1,DRect.H+Curr.Y+Curr.H-mY-1,nx,ny);
  9048.         HideMouse;
  9049.         if (Curr.X<>nx) or (Curr.Y<>ny) or bTst(Attr.ExStyle,ws_ex_MoveTransparent) then
  9050.             begin
  9051.                 if not(bTst(Attr.ExStyle,ws_ex_MoveTransparent)) then RestoreBackground;
  9052.                 Curr.X:=nx;
  9053.                 Curr.Y:=ny;
  9054.                 GRtoA2(Curr);
  9055.                 SaveBackground;
  9056.                 with pinfo do
  9057.                     begin
  9058.                         fErase:=false;
  9059.                         rcPaint:=Curr
  9060.                     end;
  9061.                 UpdateDialog;
  9062.                 InitPaint;
  9063.                 Paint(pinfo);
  9064.                 ExitPaint
  9065.             end;
  9066.         gem.graf_mouse(GP.mnr,@GP.mform);
  9067.         ShowMouse
  9068.     end;
  9069.  
  9070.  
  9071. procedure TDialog.SaveBackground;
  9072.     var box : GRECT;
  9073.         scrn: MFDB;
  9074.         pxy : ARRAY_8;
  9075.  
  9076.     begin
  9077.         if (IsModal) and (bsave) then
  9078.             begin
  9079.                 bsave:=false;
  9080.                 box:=Curr;
  9081.                 if rc_intersect(DRect,box) then
  9082.                     begin
  9083.                         with BackGr do
  9084.                             begin
  9085.                                 fd_w:=box.W;
  9086.                                 fd_h:=box.H;
  9087.                                 fd_stand:=FF_DEVSPEC;
  9088.                                 fd_wdwidth:=(fd_w+15) shr 4;
  9089.                                 fd_nplanes:=Application^.Attr.Planes;
  9090.                                 BLen:=(longint(fd_wdwidth)*longint(fd_h)*longint(fd_nplanes)) shl 1
  9091.                             end;
  9092.                         if not(bTst(Class.Style,cs_SaveBits)) then BackGr.fd_addr:=nil
  9093.                         else
  9094.                             getmem(BackGr.fd_addr,BLen);
  9095.                         if BackGr.fd_addr=nil then
  9096.                             form_dial(FMD_START,0,0,0,0,box.X,box.Y,box.W,box.H)
  9097.                         else
  9098.                             begin
  9099.                                 scrn.fd_addr:=nil;
  9100.                                 pxy[0]:=box.X;
  9101.                                 pxy[1]:=box.Y;
  9102.                                 pxy[2]:=box.X+box.W-1;
  9103.                                 pxy[3]:=box.Y+box.H-1;
  9104.                                 pxy[4]:=0;
  9105.                                 pxy[5]:=0;
  9106.                                 pxy[6]:=BackGr.fd_w-1;
  9107.                                 pxy[7]:=BackGr.fd_h-1;
  9108.                                 BValid:=true;
  9109.                                 HideMouse;
  9110.                                 vro_cpyfm(vdiHandle,S_ONLY,pxy,scrn,BackGr);
  9111.                                 ShowMouse
  9112.                             end
  9113.                     end
  9114.             end
  9115.     end;
  9116.  
  9117.  
  9118. procedure TDialog.RestoreBackground;
  9119.     var box  : GRECT;
  9120.         scrn : MFDB;
  9121.         pxy  : ARRAY_8;
  9122.  
  9123.     begin
  9124.         if (IsModal) and not(bsave) then
  9125.             begin
  9126.                 bsave:=true;
  9127.                 box:=Curr;
  9128.                 if rc_intersect(DRect,box) then
  9129.                     begin
  9130.                         if BValid then
  9131.                             begin
  9132.                                 scrn.fd_addr:=nil;
  9133.                                 pxy[0]:=0;
  9134.                                 pxy[1]:=0;
  9135.                                 pxy[2]:=BackGr.fd_w-1;
  9136.                                 pxy[3]:=BackGr.fd_h-1;
  9137.                                 pxy[4]:=box.X;
  9138.                                 pxy[5]:=box.Y;
  9139.                                 pxy[6]:=box.X+box.W-1;
  9140.                                 pxy[7]:=box.Y+box.H-1;
  9141.                                 BValid:=false;
  9142.                                 HideMouse;
  9143.                                 vro_cpyfm(vdiHandle,S_ONLY,pxy,BackGr,scrn);
  9144.                                 ShowMouse;
  9145.                                 freemem(BackGr.fd_addr,BLen)
  9146.                             end
  9147.                         else
  9148.                             begin
  9149.                                 form_dial(FMD_FINISH,0,0,0,0,box.X,box.Y,box.W,box.H);
  9150.                                 Application^.RestoreModalDialog(Parent)
  9151.                             end
  9152.                     end
  9153.             end
  9154.     end;
  9155.  
  9156.  
  9157. function TDialog.objc_edit(var ob_edchar: integer; ob_edkind: integer; clp: ARRAY_4; cclp: boolean): integer;
  9158.     label _delline,_edidx;
  9159.  
  9160.     var typ,ox,oy,toffs,q,chw,vlen: integer;
  9161.         pted                      : TEDINFOPtr;
  9162.         thechar,vchar             : char;
  9163.  
  9164.     function ValidChar(mask: char): boolean;
  9165.  
  9166.         begin
  9167.             if pedt<>nil then
  9168.                 if bTst(pedt^.Style,es_ASCIIOnly) then
  9169.                     if not(thechar in [' '..'~']) then
  9170.                         begin
  9171.                             ValidChar:=false;
  9172.                             exit
  9173.                         end;
  9174.             ValidChar:=false;
  9175.             case mask of
  9176.                 'X': ValidChar:=true;
  9177.                 '9': if thechar in ['0'..'9'] then ValidChar:=true;
  9178.                 'A': if upcase(thechar) in [' ','A'..'Z'] then
  9179.                              begin
  9180.                                  ValidChar:=true;
  9181.                                  thechar:=upcase(thechar)
  9182.                              end;
  9183.                 'a': if thechar in [' ','A'..'Z','a'..'z'] then ValidChar:=true;
  9184.                 'N': if upcase(thechar) in [' ','0'..'9','A'..'Z'] then
  9185.                              begin
  9186.                                  ValidChar:=true;
  9187.                                  thechar:=upcase(thechar)
  9188.                              end;
  9189.                 'n': if thechar in [' ','0'..'9','A'..'Z','a'..'z'] then ValidChar:=true;
  9190.                 'F': if thechar in ['!'..'-','0'..'9',';'..'[',']'..'~'] then ValidChar:=true;
  9191.                 'f': if thechar in ['!'..')','+'..'-',';'..'>','0'..'9','@'..'[',']'..'~'] then ValidChar:=true;
  9192.                 'P': if thechar in ['!'..'.','0'..'~'] then ValidChar:=true;
  9193.                 'p': if thechar in ['!'..')','+'..'.','0'..'>','@'..'~'] then ValidChar:=true;
  9194.                 'H': if upcase(thechar) in ['0'..'9','A'..'F'] then ValidChar:=true;
  9195.                 'D': if thechar in ['0'..'9','+','-',',','.'] then ValidChar:=true;
  9196.                 '+': if (thechar='+') or (thechar='-') then ValidChar:=true
  9197.             end
  9198.         end;
  9199.  
  9200.     function getmaxidx: integer;
  9201.  
  9202.         begin
  9203.             getmaxidx:=StrLen(pted^.te_ptext)
  9204.         end;
  9205.  
  9206.     procedure print(ce: boolean);
  9207.         var ot: integer;
  9208.  
  9209.         begin
  9210.             if ce then if pedt<>nil then pedt^.Edit;
  9211.             if idx>getmaxidx then
  9212.                 begin
  9213.                     idx:=getmaxidx;
  9214.                     if pedt<>nil then pedt^.EdIdx:=idx
  9215.                 end;
  9216.             ot:=DlgTree^[edit_obj].ob_type;
  9217.             DlgTree^[edit_obj].ob_type:=G_FTEXT;
  9218.             ObjcPaint(edit_obj,false);
  9219.             DlgTree^[edit_obj].ob_type:=ot;
  9220.             ob_edchar:=0
  9221.         end;
  9222.  
  9223.     procedure cursor;
  9224.         var box    : GRECT;
  9225.             visible: boolean;
  9226.  
  9227.         procedure cursor_prnt;
  9228.             var anz: integer;
  9229.  
  9230.             begin
  9231.                 q:=toffs;
  9232.                 anz:=0;
  9233.                 while anz<idx do
  9234.                     begin
  9235.                         if PChar(longint(pted^.te_ptmplt)+q)^='_' then inc(anz);
  9236.                         inc(q)
  9237.                     end;
  9238.                 if idx<pted^.te_txtlen-1 then
  9239.                     while PChar(longint(pted^.te_ptmplt)+q)^<>'_' do inc(q);
  9240.                 gem.vswr_mode(vdiHandle,MD_XOR);
  9241.                 pxya[0]:=ox+(q-toffs)*chw;
  9242.                 pxya[1]:=oy;
  9243.                 pxya[2]:=pxya[0];
  9244.                 pxya[3]:=oy+SysInfo.SFHeight+2;
  9245.                 HideMouse;
  9246.                 v_pline(vdiHandle,2,pxya);
  9247.                 ShowMouse;
  9248.                 gem.vswr_mode(vdiHandle,MD_REPLACE)
  9249.             end;
  9250.  
  9251.         begin
  9252.             if not(cclp) or IsModal then cursor_prnt
  9253.             else
  9254.                 begin
  9255.                     visible:=FirstWorkRect(box);
  9256.                     while visible do
  9257.                         begin
  9258.                             vs_clip(vdiHandle,CLIP_ON,box.A2);
  9259.                             cursor_prnt;
  9260.                             visible:=NextWorkRect(box)
  9261.                         end;
  9262.                     vs_clip(vdiHandle,CLIP_ON,DRect.A2)
  9263.                 end
  9264.         end;
  9265.  
  9266.     begin
  9267.         typ:=DlgTree^[edit_obj].ob_type and $ff;
  9268.         if (typ=G_FTEXT) or (typ=G_FBOXTEXT) then
  9269.             begin
  9270.                 objc_edit:=1;
  9271.                 pted:=DlgTree^[edit_obj].ob_spec.ted_info;
  9272.                 objc_offset(DlgTree,edit_obj,ox,oy);
  9273.                 toffs:=0;
  9274.                 inc(oy,((DlgTree^[edit_obj].ob_height-SysInfo.SFHeight) shr 1)-1);
  9275.                 while (PChar(longint(pted^.te_ptmplt)+toffs)^<>'_') and (PChar(longint(pted^.te_ptmplt)+toffs)^<>#0) do inc(toffs);
  9276.                 if pted^.te_font=SMALL then chw:=6
  9277.                     else chw:=SysInfo.SFWidth;
  9278.                 inc(ox,toffs*chw);
  9279.                 case pted^.te_just of
  9280.                     TE_RIGHT: ox:=ox+DlgTree^[edit_obj].ob_width-(pted^.te_tmplen-1)*chw;
  9281.                     TE_CNTR: inc(ox,(DlgTree^[edit_obj].ob_width+1-(pted^.te_tmplen-1)*chw) shr 1)
  9282.                 end;
  9283.                 InitVWrk;
  9284.                 vs_clip(vdiHandle,CLIP_ON,clp);
  9285.                 case ob_edkind of
  9286.                 EDINIT: begin
  9287.                                     if PChar(pted^.te_ptext)^='@' then PChar(pted^.te_ptext)^:=#0;
  9288.                                     if pedt<>nil then idx:=pedt^.EdIdx
  9289.                                         else idx:=-1;
  9290.                                     if (idx<0) or (idx>getmaxidx) then
  9291.                                         begin
  9292.                                             idx:=getmaxidx;
  9293.                                             if pedt<>nil then pedt^.EdIdx:=idx
  9294.                                         end;
  9295.                                     cursor
  9296.                                 end;
  9297.                 EDCHAR: begin
  9298.                                     cursor;
  9299.                                     obedflag:=true;
  9300.                                     _delline:
  9301.                                     case ob_edchar of
  9302.                                         S_Esc: begin
  9303.                                                          PChar(pted^.te_ptext)^:=#0;
  9304.                                                          idx:=0;
  9305.                                                          if pedt<>nil then pedt^.EdIdx:=0;
  9306.                                                          print(true)
  9307.                                                      end;
  9308.                                         BackSpace: begin
  9309.                                                                  if idx>0 then
  9310.                                                                      begin
  9311.                                                                          dec(idx);
  9312.                                                                          if pedt<>nil then pedt^.EdIdx:=idx;
  9313.                                                                          typ:=getmaxidx-1;
  9314.                                                                          if typ>idx then
  9315.                                                                              for q:=idx to typ-1 do
  9316.                                                                                  PChar(longint(pted^.te_ptext)+q)^:=PChar(longint(pted^.te_ptext)+q+1)^;
  9317.                                                                          PChar(longint(pted^.te_ptext)+typ)^:=#0;
  9318.                                                                          print(true)
  9319.                                                                      end;
  9320.                                                                  ob_edchar:=0
  9321.                                                              end;
  9322.                                         S_Delete: begin
  9323.                                                                 if (Kbshift(-1) and (K_LSHIFT or K_RSHIFT))>0 then
  9324.                                                                     begin
  9325.                                                                         ob_edchar:=S_Esc;
  9326.                                                                         goto _delline
  9327.                                                                     end;
  9328.                                                                 if idx<getmaxidx then
  9329.                                                                     begin
  9330.                                                                         typ:=getmaxidx-1;
  9331.                                                                         if typ>idx then
  9332.                                                                             for q:=idx to typ-1 do
  9333.                                                                                 PChar(longint(pted^.te_ptext)+q)^:=PChar(longint(pted^.te_ptext)+q+1)^;
  9334.                                                                         PChar(longint(pted^.te_ptext)+typ)^:=#0;
  9335.                                                                         print(true)
  9336.                                                                     end;
  9337.                                                                 ob_edchar:=0
  9338.                                                             end;
  9339.                                         Cur_Left: begin
  9340.                                                                 if idx>0 then
  9341.                                                                     begin
  9342.                                                                         dec(idx);
  9343.                                                                         if pedt<>nil then pedt^.EdIdx:=idx
  9344.                                                                     end;
  9345.                                                                 ob_edchar:=0
  9346.                                                             end;
  9347.                                         Cur_Right: begin
  9348.                                                                  if idx<getmaxidx then
  9349.                                                                      begin
  9350.                                                                          inc(idx);
  9351.                                                                          if pedt<>nil then pedt^.EdIdx:=idx
  9352.                                                                      end;
  9353.                                                                  ob_edchar:=0
  9354.                                                              end;
  9355.                                         Shift_CL,$7300: begin
  9356.                                                                             idx:=0;
  9357.                                                                             if pedt<>nil then pedt^.EdIdx:=idx;
  9358.                                                                             ob_edchar:=0
  9359.                                                                         end;
  9360.                                         Shift_CR,$7400: begin
  9361.                                                                             idx:=getmaxidx;
  9362.                                                                             if pedt<>nil then pedt^.EdIdx:=idx;
  9363.                                                                             ob_edchar:=0
  9364.                                                                         end;
  9365.                                         S_Undo: begin
  9366.                                                             if pedt<>nil then
  9367.                                                                 if pedt^.CanUndo then
  9368.                                                                     begin
  9369.                                                                         pedt^.Undo;
  9370.                                                                         print(false)
  9371.                                                                     end;
  9372.                                                             ob_edchar:=0
  9373.                                                         end
  9374.                                     else
  9375.                                         if idx<pted^.te_txtlen-1 then typ:=idx
  9376.                                         else
  9377.                                             typ:=pted^.te_txtlen-2;
  9378.                                         thechar:=chr(lo(ob_edchar));
  9379.                                         if thechar>=' ' then
  9380.                                             begin
  9381.                                                 vlen:=StrLen(pted^.te_pvalid);
  9382.                                                 if vlen=0 then vchar:='X'
  9383.                                                 else
  9384.                                                     if typ+1>vlen then vchar:=PChar(longint(pted^.te_pvalid)+vlen-1)^
  9385.                                                     else
  9386.                                                         vchar:=PChar(longint(pted^.te_pvalid)+typ)^;
  9387.                                                 if ValidChar(vchar) then
  9388.                                                     begin
  9389.                                                         if typ<=(pted^.te_txtlen-3) then
  9390.                                                             for q:=(pted^.te_txtlen-3) downto typ do
  9391.                                                                 PChar(longint(pted^.te_ptext)+q+1)^:=PChar(longint(pted^.te_ptext)+q)^;
  9392.                                                         PChar(longint(pted^.te_ptext)+typ)^:=thechar;
  9393.                                                         idx:=typ+1;
  9394.                                                         if pedt<>nil then pedt^.EdIdx:=idx;
  9395.                                                         print(true)
  9396.                                                     end
  9397.                                                 else
  9398.                                                     begin
  9399.                                                         q:=toffs;
  9400.                                                         typ:=0;
  9401.                                                         while typ<idx do
  9402.                                                             begin
  9403.                                                                 if PChar(longint(pted^.te_ptmplt)+q)^='_' then inc(typ);
  9404.                                                                 inc(q)
  9405.                                                             end;
  9406.                                                         while (PChar(longint(pted^.te_ptmplt)+q)^<>thechar) and (PChar(longint(pted^.te_ptmplt)+q)^<>#0) do
  9407.                                                             begin
  9408.                                                                 if PChar(longint(pted^.te_ptmplt)+q)^='_' then inc(typ);
  9409.                                                                 inc(q)
  9410.                                                             end;
  9411.                                                         if PChar(longint(pted^.te_ptmplt)+q)^=thechar then
  9412.                                                             begin
  9413.                                                                 if typ>idx then
  9414.                                                                     for q:=idx to typ-1 do
  9415.                                                                         PChar(longint(pted^.te_ptext)+q)^:=' ';
  9416.                                                                 PChar(longint(pted^.te_ptext)+typ)^:=#0;
  9417.                                                                 idx:=getmaxidx;
  9418.                                                                 if pedt<>nil then pedt^.EdIdx:=idx;
  9419.                                                                 print(true)
  9420.                                                             end
  9421.                                                     end
  9422.                                             end
  9423.                                     end;
  9424.                                     obedflag:=false;
  9425.                                     cursor
  9426.                                 end;
  9427.                 EDEND:  begin
  9428.                                     if pedt<>nil then pedt^.EdIdx:=idx;
  9429.                                     cursor
  9430.                                 end;
  9431.                 EDDRAW: cursor;
  9432.                 EDIDX:  begin
  9433.                                     typ:=(ob_edchar-ox) div chw;
  9434.                                     goto _edidx
  9435.                                 end;
  9436.                 EDIDXABS: begin
  9437.                                         typ:=ob_edchar;
  9438.                                         _edidx:
  9439.                                         if typ<0 then typ:=0;
  9440.                                         for q:=0 to typ do if PChar(longint(pted^.te_ptmplt)+toffs+q)^<>'_' then dec(typ);
  9441.                                         if typ>getmaxidx then typ:=getmaxidx;
  9442.                                         if typ<>idx then
  9443.                                             begin
  9444.                                                 cursor;
  9445.                                                 idx:=typ;
  9446.                                                 if pedt<>nil then pedt^.EdIdx:=idx;
  9447.                                                 cursor
  9448.                                             end
  9449.                                     end
  9450.                 else
  9451.                     objc_edit:=0
  9452.                 end;
  9453.                 RestoreVWrk
  9454.             end
  9455.         else
  9456.             objc_edit:=0
  9457.     end;
  9458.  
  9459. { *** TDIALOG *** }
  9460.  
  9461.  
  9462.  
  9463. { *** Objekt TTOOLBAR *** }
  9464.  
  9465. constructor TToolbar.Init(AParent: PWindow; ATree,AnIndx,Stat,Key: integer; Msg: pointer; GetHnd,Switch: boolean; Hlp: string);
  9466.     var tp: PTree;
  9467.  
  9468.     begin
  9469.         if not(inherited Init(AParent)) then fail;
  9470.         tp:=Application^.GetAddr(ATree);
  9471.         if (Parent=PEventObject(Application)) or (tp=nil) then
  9472.             begin
  9473.                 inherited Done;
  9474.                 fail
  9475.             end;
  9476.         ADialog:=nil;
  9477.         IsSwitch:=Switch;
  9478.         ObjTree:=ATree;
  9479.         ObjIndx:=AnIndx;
  9480.         ObjAddr:=@tp^[ObjIndx];
  9481.         if ObjAddr=nil then
  9482.             begin
  9483.                 inherited Done;
  9484.                 fail
  9485.             end;
  9486.         with ObjAddr^ do
  9487.             begin
  9488.                 if (ob_type and $ff) in [G_BOX,G_BOXTEXT,G_BUTTON,G_BOXCHAR,G_FBOXTEXT] then
  9489.                     begin
  9490.                         if IsSwitch then ob_flags:=(ob_flags and not(FL3DMASK)) or FL3DIND
  9491.                         else
  9492.                             ob_flags:=(ob_flags and not(FL3DMASK)) or FL3DACT
  9493.                     end;
  9494.                 if (GEMVersion>=$0340) and (GEMVersion<>$0399) then
  9495.                     begin
  9496.                         if (ob_type and $ff) in [G_BOXTEXT,G_FBOXTEXT] then ob_state:=ob_state and not(SHADOWED or OUTLINED)
  9497.                     end
  9498.                 else
  9499.                     if Application^.Attr.Colors>=LWhite then
  9500.                         begin
  9501.                             if (ob_type and $ff) in [G_BOXTEXT,G_FBOXTEXT] then
  9502.                                 ob_spec.ted_info^.te_color:=(ob_spec.ted_info^.te_color and $ff00) or LWhite or $0070
  9503.                             else
  9504.                                 if (ob_type and $ff) in [G_BOX,G_BOXCHAR] then
  9505.                                     ob_spec.index:=(ob_spec.index and $ffffff00) or LWhite or $0070
  9506.                         end
  9507.             end;
  9508.         BHelp:=nil;
  9509.         SetHelp(Hlp);
  9510.         VKey:=Key;
  9511.         VStat:=Stat;
  9512.         VGHnd:=GetHnd;
  9513.         if Msg<>nil then
  9514.             begin
  9515.                 new(VPipe);
  9516.                 if VPipe<>nil then
  9517.                     begin
  9518.                         VPipe^:=PPipearray(Msg)^;
  9519.                         VPipe^[1]:=Application^.apID;
  9520.                         VPipe^[2]:=0
  9521.                     end
  9522.             end
  9523.         else
  9524.             VPipe:=nil
  9525.     end;
  9526.  
  9527.  
  9528. destructor TToolbar.Done;
  9529.  
  9530.     begin
  9531.         if VPipe<>nil then dispose(VPipe);
  9532.         inherited Done
  9533.     end;
  9534.  
  9535.  
  9536. function TToolbar.TestKey(Stat,Key: integer): boolean;
  9537.  
  9538.     begin
  9539.         if (Stat=VStat) and (Key=VKey) and (GetState<>bf_Disabled) then
  9540.             begin
  9541.                 TestKey:=true;
  9542.                 if IsSwitch then Toggle
  9543.                 else
  9544.                     Check;
  9545.                 Work;
  9546.                 if VPipe<>nil then
  9547.                     begin
  9548.                         if VGHnd then VPipe^[3]:=PWindow(Parent)^.Attr.gemHandle;
  9549.                         appl_write(Application^.apID,16,VPipe)
  9550.                     end;
  9551.                 if not(IsSwitch) then Uncheck
  9552.             end
  9553.         else
  9554.             TestKey:=false
  9555.     end;
  9556.  
  9557.  
  9558. function TToolbar.TestMessage(Pipe: Pipearray): boolean;
  9559.  
  9560.     begin
  9561.         TestMessage:=false;
  9562.         if Pipe[0]=GO_PRIVATE then
  9563.             if Pipe[3]=GOP_TOOLBAR then
  9564.                 if Pipe[4]=ObjTree then
  9565.                     if Pipe[5]=ObjIndx then TestMessage:=true
  9566.     end;
  9567.  
  9568.  
  9569. function TToolbar.GetState: integer;
  9570.  
  9571.     begin
  9572.         if bTst(ObjAddr^.ob_state,DISABLED) then GetState:=bf_Disabled
  9573.         else
  9574.             GetState:=bf_Enabled
  9575.     end;
  9576.  
  9577.  
  9578. procedure TToolbar.SetState(StateFlag: integer);
  9579.  
  9580.     begin
  9581.         if GetState<>StateFlag then
  9582.             begin
  9583.                 with ObjAddr^ do
  9584.                     if StateFlag=bf_Disabled then
  9585.                         ob_state:=ob_state or DISABLED
  9586.                     else
  9587.                         ob_state:=ob_state and not(DISABLED);
  9588.                 Paint
  9589.             end
  9590.     end;
  9591.  
  9592.  
  9593. procedure TToolbar.Disable;
  9594.  
  9595.     begin
  9596.         SetState(bf_Disabled)
  9597.     end;
  9598.  
  9599.  
  9600. procedure TToolbar.Enable;
  9601.  
  9602.     begin
  9603.         SetState(bf_Enabled)
  9604.     end;
  9605.  
  9606.  
  9607. procedure TToolbar.SetCheck(CheckFlag: integer);
  9608.  
  9609.     begin
  9610.         if GetCheck<>CheckFlag then
  9611.             begin
  9612.                 with ObjAddr^ do
  9613.                     if CheckFlag=bf_Unchecked then ob_state:=ob_state and not(SELECTED)
  9614.                     else
  9615.                         ob_state:=ob_state or SELECTED;
  9616.                 Paint
  9617.             end
  9618.     end;
  9619.  
  9620.  
  9621. function TToolbar.GetCheck: integer;
  9622.  
  9623.     begin
  9624.         with ObjAddr^ do
  9625.             if bTst(ob_state,SELECTED) then GetCheck:=bf_Checked
  9626.             else
  9627.                 GetCheck:=bf_Unchecked
  9628.     end;
  9629.  
  9630.  
  9631. procedure TToolbar.Check;
  9632.  
  9633.     begin
  9634.         SetCheck(bf_Checked)
  9635.     end;
  9636.  
  9637.  
  9638. procedure TToolbar.Uncheck;
  9639.  
  9640.     begin
  9641.         SetCheck(bf_Unchecked)
  9642.     end;
  9643.  
  9644.  
  9645. procedure TToolbar.Toggle;
  9646.  
  9647.     begin
  9648.         if GetCheck=bf_Unchecked then SetCheck(bf_Checked)
  9649.         else
  9650.             SetCheck(bf_Unchecked)
  9651.     end;
  9652.  
  9653.  
  9654. procedure TToolbar.Paint;
  9655.     var box: GRECT;
  9656.  
  9657.     begin
  9658.         with PWindow(Parent)^ do
  9659.             begin
  9660.                 if Attr.Status<>ws_Open then exit;
  9661.                 if IsIconified then exit;
  9662.                 if (Class.ToolbarTree=nil) or (tbtree<>ObjTree) then exit;
  9663.                 wind_update(BEG_UPDATE);
  9664.                 HideMouse;
  9665.                 wind_get(Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  9666.                 while (box.W>0) and (box.H>0) do
  9667.                     begin
  9668.                         if rc_intersect(DRect,box) then
  9669.                             with box do objc_draw(Class.ToolbarTree,ObjIndx,MAX_DEPTH,X,Y,W,H);
  9670.                         wind_get(Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  9671.                     end;
  9672.                 ShowMouse;
  9673.                 wind_update(END_UPDATE)
  9674.             end
  9675.     end;
  9676.  
  9677.  
  9678. function TToolbar.IsHelpAvailable: boolean;
  9679.  
  9680.     begin
  9681.         if BHelp=nil then IsHelpAvailable:=false
  9682.         else
  9683.             IsHelpAvailable:=(length(StrPTrimF(BHelp^))<>0)
  9684.     end;
  9685.  
  9686.  
  9687. function TToolbar.GetHelp: string;
  9688.  
  9689.     begin
  9690.         if BHelp<>nil then GetHelp:=BHelp^ else GetHelp:=''
  9691.     end;
  9692.  
  9693.  
  9694. procedure TToolbar.SetHelp(Hlp: string);
  9695.  
  9696.     begin
  9697.         DisposeStr(BHelp);
  9698.         BHelp:=NewStr(Hlp)
  9699.     end;
  9700.  
  9701. { *** Objekt TTOOLBAR *** }
  9702.  
  9703.  
  9704.  
  9705. { *** Objekt TKEYMENU *** }
  9706.  
  9707. constructor TKeyMenu.Init(AParent: PEventObject; Stat,Key,mNum,tNum: integer);
  9708.  
  9709.     begin
  9710.         if not(inherited Init(AParent)) then fail;
  9711.         ADialog:=nil;
  9712.         VStat:=Stat;
  9713.         VKey:=Key;
  9714.         VMNum:=mNum;
  9715.         VTNum:=tNum;
  9716.         VGHnd:=false;
  9717.         VPipe:=nil
  9718.     end;
  9719.  
  9720.  
  9721. destructor TKeyMenu.Done;
  9722.  
  9723.     begin
  9724.         if VPipe<>nil then dispose(VPipe);
  9725.         inherited Done
  9726.     end;
  9727.  
  9728.  
  9729. function TKeyMenu.TestKey(Stat,Key: integer): boolean;
  9730.  
  9731.     begin
  9732.         if (Stat=VStat) and (Key=VKey) and (GetState<>bf_Disabled) then
  9733.             with Application^ do
  9734.                 begin
  9735.                     TestKey:=true;
  9736.                     if (MenuTree<>nil) and (VTNum>=0) then
  9737.                         menu_tnormal(MenuTree,VTNum,ME_INVERT);
  9738.                     Work;
  9739.                     if VPipe<>nil then
  9740.                         begin
  9741.                             if VGHnd then VPipe^[3]:=PWindow(Parent)^.Attr.gemHandle;
  9742.                             appl_write(apID,16,VPipe)
  9743.                         end;
  9744.                     if (MenuTree<>nil) and (VTNum>=0) then
  9745.                         menu_tnormal(MenuTree,VTNum,ME_NORMAL)
  9746.                 end
  9747.         else
  9748.             TestKey:=false
  9749.     end;
  9750.  
  9751.  
  9752. function TKeyMenu.TestMenu(mNum: integer): boolean;
  9753.  
  9754.     begin
  9755.         if mNum=VMNum then
  9756.             begin
  9757.                 TestMenu:=true;
  9758.                 if VPipe<>nil then
  9759.                     begin
  9760.                         if VGHnd then VPipe^[3]:=PWindow(Parent)^.Attr.gemHandle;
  9761.                         appl_write(Application^.apID,16,VPipe)
  9762.                     end;
  9763.                 Work
  9764.             end
  9765.         else
  9766.          TestMenu:=false
  9767.     end;
  9768.  
  9769.  
  9770. function TKeyMenu.GetState: integer;
  9771.  
  9772.     begin
  9773.         if (Application^.MenuTree<>nil) and (VMNum>=0) then
  9774.             begin
  9775.                 if bTst(Application^.MenuTree^[VMNum].ob_state,DISABLED) then GetState:=bf_Disabled
  9776.                 else
  9777.                     GetState:=bf_Enabled
  9778.             end
  9779.         else
  9780.             GetState:=id_No
  9781.     end;
  9782.  
  9783.  
  9784. procedure TKeyMenu.SetState(StateFlag: integer);
  9785.  
  9786.     begin
  9787.         if InitMWrk then
  9788.             begin
  9789.                 if StateFlag=bf_Disabled then menu_ienable(Application^.MenuTree,VMNum,ME_DISABLE)
  9790.                 else
  9791.                     menu_ienable(Application^.MenuTree,VMNum,ME_ENABLE);
  9792.                 ExitMWrk
  9793.             end
  9794.     end;
  9795.  
  9796.  
  9797. procedure TKeyMenu.Disable;
  9798.  
  9799.     begin
  9800.         SetState(bf_Disabled)
  9801.     end;
  9802.  
  9803.  
  9804. procedure TKeyMenu.Enable;
  9805.  
  9806.     begin
  9807.         SetState(bf_Enabled)
  9808.     end;
  9809.  
  9810.  
  9811. function TKeyMenu.GetText: string;
  9812.  
  9813.     begin
  9814.         if (Application^.MenuTree<>nil) and (VMNum>=0) then
  9815.             GetText:=StrPas(Application^.MenuTree^[VMNum].ob_spec.free_string)
  9816.         else
  9817.             GetText:=''
  9818.     end;
  9819.  
  9820.  
  9821. procedure TKeyMenu.SetText(ATextString: string);
  9822.  
  9823.     begin
  9824.         if InitMWrk then
  9825.             begin
  9826.                 menu_text(Application^.MenuTree,VMNum,ATextString);
  9827.                 ExitMWrk
  9828.             end
  9829.     end;
  9830.  
  9831.  
  9832. function TKeyMenu.GetCheck: integer;
  9833.  
  9834.     begin
  9835.         if (Application^.MenuTree<>nil) and (VMNum>=0) then
  9836.             begin
  9837.                 if bTst(Application^.MenuTree^[VMNum].ob_state,CHECKED) then GetCheck:=bf_Checked
  9838.                 else
  9839.                     GetCheck:=bf_Unchecked
  9840.             end
  9841.         else
  9842.             GetCheck:=id_No
  9843.     end;
  9844.  
  9845.  
  9846. procedure TKeyMenu.SetCheck(CheckFlag: integer);
  9847.  
  9848.     begin
  9849.         if InitMWrk then
  9850.             begin
  9851.                 if CheckFlag=bf_Checked then menu_icheck(Application^.MenuTree,VMNum,ME_CHECK)
  9852.                 else
  9853.                     menu_icheck(Application^.MenuTree,VMNum,ME_UNCHECK);
  9854.                 ExitMWrk
  9855.             end
  9856.     end;
  9857.  
  9858.  
  9859. procedure TKeyMenu.Check;
  9860.  
  9861.     begin
  9862.         SetCheck(bf_Checked)
  9863.     end;
  9864.  
  9865.  
  9866. procedure TKeyMenu.Uncheck;
  9867.  
  9868.     begin
  9869.         SetCheck(bf_Unchecked)
  9870.     end;
  9871.  
  9872.  
  9873. procedure TKeyMenu.Toggle;
  9874.  
  9875.     begin
  9876.         if GetCheck=bf_Unchecked then SetCheck(bf_Checked)
  9877.         else
  9878.             SetCheck(bf_Unchecked)
  9879.     end;
  9880.  
  9881.  
  9882.     { private }
  9883.  
  9884.  
  9885. function TKeyMenu.InitMWrk: boolean;
  9886.     var valid: boolean;
  9887.  
  9888.     begin
  9889.         valid:=(Application^.MenuTree<>nil) and (VMNum>=0);
  9890.         if valid then wind_update(BEG_UPDATE);
  9891.         InitMWrk:=valid
  9892.     end;
  9893.  
  9894.  
  9895. procedure TKeyMenu.ExitMWrk;
  9896.  
  9897.     begin
  9898.         Application^.DrawMenu;
  9899.         wind_update(END_UPDATE)
  9900.     end;
  9901.  
  9902. { *** TKEYMENU *** }
  9903.  
  9904.  
  9905.  
  9906. { *** Objekt TKEY *** }
  9907.  
  9908. constructor TKey.Init(AParent: PEventObject; Stat,Key: integer; Msg: pointer; GetHnd: boolean);
  9909.  
  9910.     begin
  9911.         if not(inherited Init(AParent,Stat,Key,-1,-1)) then fail;
  9912.         VGHnd:=GetHnd;
  9913.         if Msg<>nil then
  9914.             begin
  9915.                 new(VPipe);
  9916.                 if VPipe<>nil then
  9917.                     begin
  9918.                         VPipe^:=PPipearray(Msg)^;
  9919.                         VPipe^[1]:=Application^.apID;
  9920.                         VPipe^[2]:=0
  9921.                     end
  9922.             end
  9923.     end;
  9924.  
  9925.  
  9926. function TKey.TestMenu(mNum: integer): boolean;
  9927.  
  9928.     begin
  9929.         TestMenu:=false
  9930.     end;
  9931.  
  9932. { *** TKEY *** }
  9933.  
  9934.  
  9935.  
  9936. { *** Objekt TMENU *** }
  9937.  
  9938. constructor TMenu.Init(AParent: PEventObject; mNum: integer; Msg: pointer; GetHnd: boolean);
  9939.  
  9940.     begin
  9941.         if not(inherited Init(AParent,-1,-1,mNum,-1)) then fail;
  9942.         VGHnd:=GetHnd;
  9943.         if Msg<>nil then
  9944.             begin
  9945.                 new(VPipe);
  9946.                 if VPipe<>nil then
  9947.                     begin
  9948.                         VPipe^:=PPipearray(Msg)^;
  9949.                         VPipe^[1]:=Application^.apID;
  9950.                         VPipe^[2]:=0
  9951.                     end
  9952.             end
  9953.     end;
  9954.  
  9955.  
  9956. function TMenu.TestKey(Stat,Key: integer): boolean;
  9957.  
  9958.     begin
  9959.         TestKey:=false
  9960.     end;
  9961.  
  9962. { *** TMENU *** }
  9963.  
  9964.  
  9965.  
  9966. function TFUKey.TestKey(Stat,Key: integer): boolean;
  9967.     var test: integer;
  9968.  
  9969.     begin
  9970.         if (Stat=VStat) and (Key=VKey) then
  9971.             begin
  9972.                 TestKey:=true;
  9973.                 if Key=Ctrl_Fuller then test:=FULLER
  9974.                 else
  9975.                     if Key=Ctrl_U then test:=CLOSER
  9976.                     else
  9977.                         test:=0;
  9978.                 if test>0 then
  9979.                     if bTst(PWindow(Parent)^.Attr.Style,test) then inherited TestKey(Stat,Key)
  9980.             end
  9981.         else
  9982.             TestKey:=false
  9983.     end;
  9984.  
  9985.  
  9986. function TWKey.TestKey(Stat,Key: integer): boolean;
  9987.     label _again,_child;
  9988.  
  9989.     var valid: boolean;
  9990.         p    : PWindow;
  9991.  
  9992.     begin
  9993.         valid:=(((Stat and (K_CTRL+K_RSHIFT+K_LSHIFT))>=K_CTRL) and (Key=Ctrl_W));
  9994.         if valid then
  9995.             begin
  9996.                 { <Shift>+<W> behandeln, Fehler bei Child-Windows!!! ... }
  9997.                 p:=PWindow(Parent);
  9998.                 _child:
  9999.                 if p^.ChildList<>nil then
  10000.                     with p^ do
  10001.                         begin
  10002.                             if ChildList^.IsModeless then ChildList^.Top
  10003.                             else
  10004.                                 begin
  10005.                                     p:=ChildList;
  10006.                                     goto _child
  10007.                                 end
  10008.                         end
  10009.                 else
  10010.                     begin
  10011.                         _again:
  10012.                         if p^.Nxt<>nil then
  10013.                             with p^ do
  10014.                                 begin
  10015.                                     if Nxt^.IsModeless then Nxt^.Top
  10016.                                     else
  10017.                                         begin
  10018.                                             p:=Nxt;
  10019.                                             goto _child
  10020.                                         end
  10021.                                 end
  10022.                         else
  10023.                             begin
  10024.                                 if p^.Parent=nil then
  10025.                                     with Application^ do
  10026.                                         begin
  10027.                                             if MainWindow^.IsModeless then MainWindow^.Top
  10028.                                             else
  10029.                                                 begin
  10030.                                                     p:=MainWindow;
  10031.                                                     goto _child
  10032.                                                 end
  10033.                                         end
  10034.                                 else
  10035.                                     begin
  10036.                                         p:=p^.Parent;
  10037.                                         goto _again
  10038.                                     end
  10039.                             end
  10040.                     end
  10041.             end;
  10042.         TestKey:=valid
  10043.     end;
  10044.  
  10045.  
  10046. function TDKey.TestKey(Stat,Key: integer): boolean;
  10047.     var nx,dummy,tx,robj,mx,my: integer;
  10048.         valid,found           : boolean;
  10049.         kpc,pcte              : PControl;
  10050.  
  10051.     procedure invrt(tid: integer);
  10052.         var p: PControl;
  10053.  
  10054.         begin
  10055.             with PDialog(Parent)^ do
  10056.                 begin
  10057.                     kpc:=nil;
  10058.                     p:=CtrlList;
  10059.                     while (p<>nil) do
  10060.                         with p^ do
  10061.                             begin
  10062.                                 if TestID(tid) then kpc:=p;
  10063.                                 p:=Nxt
  10064.                             end;
  10065.                     if kpc<>nil then
  10066.                         begin
  10067.                             if bTst(DlgTree^[kpc^.ObjIndx].ob_flags,SELECTABLE) then
  10068.                                 begin
  10069.                                     DlgTree^[kpc^.ObjIndx].ob_state:=DlgTree^[kpc^.ObjIndx].ob_state or SELECTED;
  10070.                                     ObjcPaint(kpc^.ObjIndx,false)
  10071.                                 end
  10072.                             else
  10073.                                 kpc:=nil
  10074.                         end
  10075.                 end
  10076.         end;
  10077.  
  10078.     begin
  10079.         TestKey:=false;
  10080.         with PDialog(Parent)^ do
  10081.             if Cont then
  10082.                 begin
  10083.                     dummy:=MapKey(Key);
  10084.                     if bTst(hi(dummy),KsALT) then
  10085.                         begin
  10086.                             Cont:=true;
  10087.                             Key:=0;
  10088.                             next_obj:=0;
  10089.                             nx:=0;
  10090.                             dummy:=ord(upcase(chr(lo(dummy))));
  10091.                             kpc:=CtrlList;
  10092.                             while (kpc<>nil) and Cont do
  10093.                                 begin
  10094.                                     if kpc^.TestShortCut(dummy) then
  10095.                                         begin
  10096.                                             TestKey:=true;
  10097.                                             if kpc^.GetState<>bf_Disabled then
  10098.                                                 begin
  10099.                                                     Cont:=false;
  10100.                                                     nx:=kpc^.ObjIndx
  10101.                                                 end
  10102.                                         end;
  10103.                                     kpc:=kpc^.Nxt
  10104.                                 end;
  10105.                             if not(Cont) then
  10106.                                 begin
  10107.                                     dummy:=DlgTree^[nx].ob_state;
  10108.                                     if bTst(DlgTree^[nx].ob_flags,SELECTABLE) then
  10109.                                         begin
  10110.                                             if bTst(DlgTree^[nx].ob_flags,RBUTTON) then
  10111.                                                 begin
  10112.                                                     if not(bTst(dummy,SELECTED)) then
  10113.                                                         begin
  10114.                                                             robj:=nx;
  10115.                                                             repeat
  10116.                                                                 tx:=DlgTree^[robj].ob_next;
  10117.                                                                 if DlgTree^[tx].ob_tail=robj then
  10118.                                                                     robj:=DlgTree^[tx].ob_head
  10119.                                                                 else
  10120.                                                                     robj:=tx;
  10121.                                                                 if bTst(DlgTree^[robj].ob_state,SELECTED) then
  10122.                                                                     begin
  10123.                                                                         objc_change(DlgTree,robj,0,0,0,1,1,DlgTree^[robj].ob_state and not(SELECTED),1);
  10124.                                                                         ObjcPaint(robj,false)
  10125.                                                                     end;
  10126.                                                             until robj=nx;
  10127.                                                             objc_change(DlgTree,nx,0,0,0,1,1,dummy or SELECTED,1);
  10128.                                                             ObjcPaint(nx,false);
  10129.                                                             CallChanged(nx,false,false,false)
  10130.                                                         end
  10131.                                                 end
  10132.                                             else
  10133.                                                 begin
  10134.                                                     if bTst(DlgTree^[nx].ob_flags,F_EXIT) then dummy:=dummy or SELECTED
  10135.                                                         else dummy:=dummy xor SELECTED;
  10136.                                                     objc_change(DlgTree,nx,0,0,0,1,1,dummy,1);
  10137.                                                     ObjcPaint(nx,false);
  10138.                                                     CallChanged(nx,false,false,false)
  10139.                                                 end
  10140.                                         end;
  10141.                                     if (DlgTree^[nx].ob_flags and (F_EXIT or TOUCHEXIT))=0 then Cont:=true
  10142.                                         else EndDlg(nx,false);
  10143.                                     exit
  10144.                                 end
  10145.                         end
  10146.                     else
  10147.                         Cont:=(Application^.form_keybd(DlgTree,edit_obj,0,Key,next_obj,Key)<>0);
  10148.                     if not(Cont) then
  10149.                         begin
  10150.                             TestKey:=true;
  10151.                             nx:=next_obj;
  10152.                             next_obj:=0;
  10153.                             if bTst(DlgTree^[nx].ob_flags,SELECTABLE) then
  10154.                                 begin
  10155.                                     DlgTree^[nx].ob_state:=DlgTree^[nx].ob_state or SELECTED;
  10156.                                     ObjcPaint(nx,false)
  10157.                                 end;
  10158.                             CallChanged(nx,false,false,false);
  10159.                             EndDlg(nx,false);
  10160.                             exit
  10161.                         end;
  10162.                     if Key<>0 then
  10163.                         begin
  10164.                             found:=false;
  10165.                             valid:=false;
  10166.                             case Key of
  10167.                             S_Help: begin
  10168.                                                 TestKey:=true;
  10169.                                                 graf_mkstate(mx,my,dummy,dummy);
  10170.                                                 tx:=objc_find(DlgTree,ROOT,MAX_DEPTH,mx,my);
  10171.                                                 if tx>-1 then
  10172.                                                     begin
  10173.                                                         pcte:=CtrlList;
  10174.                                                         while (pcte<>nil) do
  10175.                                                             with pcte^ do
  10176.                                                                 begin
  10177.                                                                     if TestIndex(tx) then
  10178.                                                                         if IsHelpAvailable then
  10179.                                                                             begin
  10180.                                                                                 Application^.BubbleHelp(mx,my,bbldelay,GetHelp);
  10181.                                                                                 valid:=true
  10182.                                                                             end;
  10183.                                                                     pcte:=Nxt
  10184.                                                                 end
  10185.                                                     end;
  10186.                                                 if not(valid) then
  10187.                                                     begin
  10188.                                                       invrt(id_Help);
  10189.                                                         valid:=Help;
  10190.                                                         found:=true
  10191.                                                     end
  10192.                                             end
  10193.                             else
  10194.                                 if edit_obj>0 then
  10195.                                     begin
  10196.                                         objc_edit(Key,EDCHAR,Work.A2,true);
  10197.                                         TestKey:=(Key=0)
  10198.                                     end
  10199.                                 else
  10200.                                     case Key of
  10201.                                     S_Esc: begin
  10202.                                                      TestKey:=true;
  10203.                                                      invrt(id_Esc);
  10204.                                                      valid:=Esc;
  10205.                                                      found:=true
  10206.                                                  end;
  10207.                                     S_Undo: begin
  10208.                                                         TestKey:=true;
  10209.                                                         invrt(id_Undo);
  10210.                                                          valid:=Undo;
  10211.                                                          found:=true
  10212.                                                     end
  10213.                                     end
  10214.                             end;
  10215.                             if found then
  10216.                                 begin
  10217.                                     if valid then
  10218.                                         begin
  10219.                                             Result:=id_No;
  10220.                                             if CanClose then
  10221.                                                 begin
  10222.                                                     if kpc<>nil then
  10223.                                                         DlgTree^[kpc^.ObjIndx].ob_state:=DlgTree^[kpc^.ObjIndx].ob_state and not(SELECTED);
  10224.                                                     Cont:=false;
  10225.                                                     Destroy;
  10226.                                                     exit
  10227.                                                 end
  10228.                                             else
  10229.                                                 if kpc<>nil then
  10230.                                                     begin
  10231.                                                         DlgTree^[kpc^.ObjIndx].ob_state:=DlgTree^[kpc^.ObjIndx].ob_state and not(SELECTED);
  10232.                                                         ObjcPaint(kpc^.ObjIndx,false)
  10233.                                                     end
  10234.                                         end
  10235.                                     else
  10236.                                         if kpc<>nil then
  10237.                                             begin
  10238.                                                 DlgTree^[kpc^.ObjIndx].ob_state:=DlgTree^[kpc^.ObjIndx].ob_state and not(SELECTED);
  10239.                                                 ObjcPaint(kpc^.ObjIndx,false)
  10240.                                             end
  10241.                                 end
  10242.                         end;
  10243.                     if (next_obj>0) and (edit_obj<>next_obj) then
  10244.                         begin
  10245.                             objc_edit(dummy,EDEND,Work.A2,true);
  10246.                             edit_obj:=next_obj;
  10247.                             next_obj:=0;
  10248.                             CallChanged(edit_obj,false,true,false);
  10249.                             objc_edit(dummy,EDINIT,Work.A2,true)
  10250.                         end
  10251.                 end
  10252.     end;
  10253.  
  10254.  
  10255. procedure TIKey.Work;
  10256.     var ICFGetPos: function(d1,d2: pointer; d3,d4,d5: longint; fn: integer; px,py,pw,ph: pointer): integer;
  10257.         x,y,w,h  : integer;
  10258.         p        : PWindow;
  10259.  
  10260.     begin
  10261.         p:=PWindow(Parent);
  10262.         if (icfserver<>nil) and not(p^.IsIconified) then
  10263.             begin
  10264.                 ICFGetPos:=icfserver;
  10265.                 p^.icfpos:=ICFGetPos(nil,nil,0,0,0,ICF_GETPOS,@x,@y,@w,@h);
  10266.                 if p^.icfpos>=0 then
  10267.                     begin
  10268.                         p^.GetCurr;
  10269.                         p^.icfcurr:=p^.Curr;
  10270.                         p^.WMIconify(x,y,w,h)
  10271.                     end
  10272.             end
  10273.     end;
  10274.  
  10275.  
  10276. procedure TQKey.Work;
  10277.  
  10278.     begin
  10279.         Application^.Quit
  10280.     end;
  10281.  
  10282.  
  10283. constructor TIcnWnd.Init(AParent: PWindow; ATitle: string; x,y,w,h: integer);
  10284.  
  10285.     begin
  10286.         if not(inherited Init(AParent,ATitle)) then fail;
  10287.         icx:=x;
  10288.         icy:=y;
  10289.         icw:=w;
  10290.         ich:=h;
  10291.         Create;
  10292.         if Attr.Status in [ws_Created,ws_Open] then
  10293.             wind_set(Attr.gemHandle,WF_ICONIFY,icx,icy,icw,ich);
  10294.         GetCurr;
  10295.         GetWork;
  10296.         OpenWindow
  10297.     end;
  10298.  
  10299.  
  10300. procedure TIcnWnd.MakeWindow;
  10301.     var valid: boolean;
  10302.  
  10303.     begin
  10304.         valid:=(Attr.Status=ws_NoWindow);
  10305.         Create;
  10306.         if valid and (Attr.Status=ws_Created) then
  10307.             wind_set(Attr.gemHandle,WF_ICONIFY,icx,icy,icw,ich);
  10308.         GetCurr;
  10309.         GetWork;
  10310.         OpenWindow
  10311.     end;
  10312.  
  10313.  
  10314. procedure TIcnWnd.IconPaint(var PaintInfo: TPaintStruct);
  10315.  
  10316.     begin
  10317.         Application^.IconPaint(Work,PaintInfo)
  10318.     end;
  10319.  
  10320.  
  10321. procedure TXAccCollection.FreeItem(Item: pointer);
  10322.  
  10323.     begin
  10324.         if Item<>nil then
  10325.             begin
  10326.                 with PXAccAttr(Item)^ do
  10327.                     begin
  10328.                         DisposeStr(AppTypeHR);
  10329.                         DisposeStr(ExtFeatures);
  10330.                         DisposeStr(GenericName);
  10331.                         DisposeStr(Name)
  10332.                     end;
  10333.                 dispose(PXAccAttr(Item));
  10334.             end
  10335.     end;
  10336.  
  10337.  
  10338. procedure TProfileCollection.FreeItem(Item: pointer);
  10339.  
  10340.     begin
  10341.         ChrDispose(PChar(Item))
  10342.     end;
  10343.  
  10344.  
  10345. procedure IconifyFadeout(p: PWindow);
  10346.  
  10347.     begin
  10348.         if p<>Application^.icnwnd then p^.Iconify(true)
  10349.     end;
  10350.  
  10351.  
  10352. procedure IconifyFadein(p: PWindow);
  10353.  
  10354.     begin
  10355.         if p<>Application^.icnwnd then p^.Iconify(false)
  10356.     end;
  10357.  
  10358.  
  10359. procedure SendXaccExit(p: PXAccAttr);
  10360.     var pipe: Pipearray;
  10361.  
  10362.     begin
  10363.         pipe[1]:=Application^.apID;
  10364.         pipe[2]:=0;
  10365.         if bTst(p^.Protocol,PROTO_XACC) then
  10366.             begin
  10367.                 pipe[0]:=ACC_EXIT;
  10368.                 appl_write(p^.apID,16,@pipe)
  10369.             end;
  10370.         if bTst(p^.Protocol,PROTO_AV) then
  10371.             begin
  10372.                 pipe[0]:=AV_EXIT;
  10373.                 pipe[3]:=pipe[1];
  10374.                 appl_write(p^.apID,16,@pipe)
  10375.             end
  10376.     end;
  10377.  
  10378.  
  10379. procedure InitVWrk;
  10380.     var dummy: integer;
  10381.         dstr : string[32];
  10382.  
  10383.     begin
  10384.         with Application^ do
  10385.             begin
  10386.                 gem.vswr_mode(vdiHandle,MD_REPLACE);
  10387.                 gem.vst_font(vdiHandle,vqt_name(vdiHandle,1,dstr));
  10388.                 gem.vst_height(vdiHandle,SysInfo.SFHeight,dummy,dummy,dummy,dummy);
  10389.                 gem.vst_rotation(vdiHandle,0);
  10390.                 gem.vst_color(vdiHandle,Black);
  10391.                 gem.vst_alignment(vdiHandle,TA_LEFT,TA_BASELINE,dummy,dummy);
  10392.                 gem.vst_effects(vdiHandle,TF_NORMAL);
  10393.                 gem.vsf_interior(vdiHandle,FIS_HOLLOW);
  10394.                 gem.vsf_style(vdiHandle,4);
  10395.                 gem.vsf_color(vdiHandle,Black);
  10396.                 gem.vsf_perimeter(vdiHandle,PER_ON);
  10397.                 gem.vsl_color(vdiHandle,Black);
  10398.                 gem.vsl_type(vdiHandle,LT_SOLID);
  10399.                 gem.vsl_width(vdiHandle,1)
  10400.             end
  10401.     end;
  10402.  
  10403.  
  10404. procedure RestoreVWrk;
  10405.     var dummy: integer;
  10406.  
  10407.     begin
  10408.         with Application^ do
  10409.             begin
  10410.                 gem.vst_font(vdiHandle,GP.font);
  10411.                 if GP.tpoint>=0 then gem.vst_point(vdiHandle,GP.tpoint,dummy,dummy,dummy,dummy)
  10412.                     else gem.vst_height(vdiHandle,GP.theight,dummy,dummy,dummy,dummy);
  10413.                 gem.vst_rotation(vdiHandle,GP.trotation);
  10414.                 gem.vst_color(vdiHandle,GP.tcolor);
  10415.                 gem.vst_alignment(vdiHandle,GP.horalign,GP.veralign,dummy,dummy);
  10416.                 gem.vst_effects(vdiHandle,GP.teffects);
  10417.                 gem.vsf_perimeter(vdiHandle,GP.fperimeter);
  10418.                 gem.vsf_interior(vdiHandle,GP.finterior);
  10419.                 gem.vsf_style(vdiHandle,GP.fstyle);
  10420.                 gem.vsf_color(vdiHandle,GP.fcolor);
  10421.                 gem.vsl_type(vdiHandle,GP.ltype);
  10422.                 gem.vsl_width(vdiHandle,GP.lwidth);
  10423.                 gem.vsl_color(vdiHandle,GP.lcolor);
  10424.                 gem.vswr_mode(vdiHandle,GP.wrmode);
  10425.                 vs_clip(vdiHandle,CLIP_ON,DRect.A2)
  10426.             end
  10427.     end;
  10428.  
  10429.  
  10430. function DrawMenuRect(dummy1,dummy2: pointer; parm: PARMBLKPtr): word;
  10431.     var pxy: ARRAY_4;
  10432.  
  10433.     begin
  10434.         with parm^ do
  10435.             begin
  10436.                 pxy[0]:=pb_x;
  10437.                 pxy[1]:=pb_y+(pb_h shr 1)-1;
  10438.                 pxy[2]:=pb_x+pb_w-1;
  10439.                 pxy[3]:=pb_y+(pb_h shr 1)
  10440.             end;
  10441.         InitVWrk;
  10442.         with Application^ do
  10443.             begin
  10444.                 if Attr.Colors>=LWhite then
  10445.                     begin
  10446.                         gem.vsf_interior(vdiHandle,FIS_SOLID);
  10447.                         gem.vsf_color(vdiHandle,LWhite)
  10448.                     end
  10449.                 else
  10450.                     gem.vsf_interior(vdiHandle,FIS_PATTERN);
  10451.                 vr_recfl(vdiHandle,pxy)
  10452.             end;
  10453.         RestoreVWrk;
  10454.         DrawMenuRect:=NORMAL
  10455.     end;
  10456.  
  10457.  
  10458. function DrawTitle(dummy1,dummy2: pointer; parm: PARMBLKPtr): word;
  10459.     var clip: ARRAY_4;
  10460.  
  10461.     begin
  10462.         InitVWrk;
  10463.         with parm^ do
  10464.             begin
  10465.                 clip[0]:=pb_xc;
  10466.                 clip[1]:=pb_yc;
  10467.                 clip[2]:=pb_xc+pb_wc-1;
  10468.                 clip[3]:=pb_yc+pb_hc-1
  10469.             end;
  10470.         with Application^ do
  10471.             begin
  10472.                 vs_clip(vdiHandle,CLIP_ON,clip);
  10473.                 gem.vst_effects(vdiHandle,TF_UNDERLINED);
  10474.                 gem.vswr_mode(vdiHandle,MD_ERASE);
  10475.                 gem.vst_color(vdiHandle,SysInfo.BGDefCol);
  10476.                 v_gtext(vdiHandle,parm^.pb_x,parm^.pb_y+SysInfo.SFHeight,StrPas(PChar(parm^.pb_parm)));
  10477.                 gem.vswr_mode(vdiHandle,MD_TRANS);
  10478.                 gem.vst_color(vdiHandle,Black);
  10479.                 v_gtext(vdiHandle,parm^.pb_x,parm^.pb_y+SysInfo.SFHeight,StrPas(PChar(parm^.pb_parm)))
  10480.             end;
  10481.         RestoreVWrk;
  10482.         DrawTitle:=NORMAL
  10483.     end;
  10484.  
  10485.  
  10486. function DrawStatic(dummy1,dummy2: pointer; parm: PARMBLKPtr): word;
  10487.     var clip: ARRAY_4;
  10488.  
  10489.     begin
  10490.         InitVWrk;
  10491.         with parm^ do
  10492.             begin
  10493.                 clip[0]:=pb_xc;
  10494.                 clip[1]:=pb_yc;
  10495.                 clip[2]:=pb_xc+pb_wc-1;
  10496.                 clip[3]:=pb_yc+pb_hc-1
  10497.             end;
  10498.         with Application^ do
  10499.             begin
  10500.                 vs_clip(vdiHandle,CLIP_ON,clip);
  10501.                 if bTst(parm^.pr_currstate,DISABLED) then gem.vst_effects(vdiHandle,TF_LIGHTENED);
  10502.                 gem.vswr_mode(vdiHandle,MD_ERASE);
  10503.                 gem.vst_color(vdiHandle,SysInfo.BGDefCol);
  10504.                 v_gtext(vdiHandle,parm^.pb_x,parm^.pb_y+SysInfo.SFHeight,StrPas(PChar(parm^.pb_parm)));
  10505.                 gem.vswr_mode(vdiHandle,MD_TRANS);
  10506.                 gem.vst_color(vdiHandle,Black);
  10507.                 v_gtext(vdiHandle,parm^.pb_x,parm^.pb_y+SysInfo.SFHeight,StrPas(PChar(parm^.pb_parm)))
  10508.             end;
  10509.         RestoreVWrk;
  10510.         DrawStatic:=parm^.pr_currstate and not(DISABLED)
  10511.     end;
  10512.  
  10513.  
  10514. function DrawPushButton(dummy1,dummy2: pointer; parm: PARMBLKPtr): word;
  10515.     var clip         : ARRAY_4;
  10516.         q,ty,tx,scpos: integer;
  10517.         btn          : string[30];
  10518.  
  10519.     begin
  10520.         InitVWrk;
  10521.         with parm^ do
  10522.             begin
  10523.                 clip[0]:=pb_xc;
  10524.                 clip[1]:=pb_yc;
  10525.                 clip[2]:=pb_xc+pb_wc-1;
  10526.                 clip[3]:=pb_yc+pb_hc-1;
  10527.                 vs_clip(Application^.vdiHandle,CLIP_ON,clip);
  10528.                 inc(pb_x,5);
  10529.                 inc(pb_y,5);
  10530.                 dec(pb_w,10);
  10531.                 dec(pb_h,10);
  10532.                 clip[0]:=pb_x-1;
  10533.                 clip[1]:=pb_y-1;
  10534.                 clip[2]:=pb_x+pb_w;
  10535.                 clip[3]:=pb_y+pb_h-1
  10536.             end;
  10537.         with Application^ do
  10538.             begin
  10539.                 gem.vsf_interior(vdiHandle,FIS_SOLID);
  10540.                 gem.vsf_color(vdiHandle,bfalcol);
  10541.                 v_bar(vdiHandle,clip);
  10542.                 btn:=StrLPas(PChar(parm^.pb_parm),30);
  10543.                 scpos:=pos('&',btn);
  10544.                 if scpos>0 then
  10545.                     begin
  10546.                         for q:=scpos to length(btn)-1 do btn[q]:=btn[q+1];
  10547.                         btn[0]:=chr(ord(btn[0])-1)
  10548.                     end;
  10549.                 tx:=parm^.pb_x+((parm^.pb_w-length(btn)*Attr.charSWidth) shr 1);
  10550.                 ty:=parm^.pb_y+SysInfo.SFHeight-1;
  10551.                 if bTst(parm^.pr_currstate,SELECTED) then
  10552.                     begin
  10553.                         pxya[0]:=clip[0]-1;
  10554.                         pxya[1]:=clip[3];
  10555.                         pxya[2]:=pxya[0];
  10556.                         pxya[3]:=clip[1]-1;
  10557.                         pxya[4]:=clip[2];
  10558.                         pxya[5]:=pxya[3];
  10559.                         gem.vsl_color(vdiHandle,Black);
  10560.                         v_pline(vdiHandle,3,pxya);
  10561.                         pxya[0]:=clip[0];
  10562.                         pxya[1]:=clip[3]+1;
  10563.                         pxya[2]:=clip[2]+1;
  10564.                         pxya[3]:=pxya[1];
  10565.                         pxya[4]:=pxya[2];
  10566.                         pxya[5]:=clip[1];
  10567.                         gem.vsl_color(vdiHandle,White);
  10568.                         v_pline(vdiHandle,3,pxya);
  10569.                         inc(tx);
  10570.                         inc(ty)
  10571.                     end
  10572.                 else
  10573.                     begin
  10574.                         pxya[0]:=clip[0]-1;
  10575.                         pxya[1]:=clip[3];
  10576.                         pxya[2]:=pxya[0];
  10577.                         pxya[3]:=clip[1]-1;
  10578.                         pxya[4]:=clip[2];
  10579.                         pxya[5]:=pxya[3];
  10580.                         gem.vsl_color(vdiHandle,White);
  10581.                         v_pline(vdiHandle,3,pxya);
  10582.                         pxya[0]:=clip[0];
  10583.                         pxya[1]:=clip[3]+1;
  10584.                         pxya[2]:=clip[2]+1;
  10585.                         pxya[3]:=pxya[1];
  10586.                         pxya[4]:=pxya[2];
  10587.                         pxya[5]:=clip[1];
  10588.                         gem.vsl_color(vdiHandle,Black);
  10589.                         v_pline(vdiHandle,3,pxya)
  10590.                     end;
  10591.                 gem.vsl_color(vdiHandle,bfalcol);
  10592.                 pxya[0]:=clip[0]-1;
  10593.                 pxya[1]:=clip[3]+1;
  10594.                 pxya[2]:=pxya[0];
  10595.                 pxya[3]:=pxya[1];
  10596.                 v_pline(vdiHandle,2,pxya);
  10597.                 pxya[0]:=clip[2]+1;
  10598.                 pxya[1]:=clip[1]-1;
  10599.                 pxya[2]:=pxya[0];
  10600.                 pxya[3]:=pxya[1];
  10601.                 v_pline(vdiHandle,2,pxya);
  10602.                 gem.vsl_color(vdiHandle,Black);
  10603.                 dec(clip[0],2);
  10604.                 dec(clip[1],2);
  10605.                 inc(clip[2],2);
  10606.                 inc(clip[3],2);
  10607.                 pxya[0]:=clip[0];
  10608.                 pxya[1]:=clip[1];
  10609.                 pxya[2]:=clip[2];
  10610.                 pxya[3]:=clip[1];
  10611.                 pxya[4]:=clip[2];
  10612.                 pxya[5]:=clip[3];
  10613.                 pxya[6]:=clip[0];
  10614.                 pxya[7]:=clip[3];
  10615.                 pxya[8]:=pxya[0];
  10616.                 pxya[9]:=pxya[1];
  10617.                 v_pline(vdiHandle,5,pxya);
  10618.                 dec(clip[0]);
  10619.                 dec(clip[1]);
  10620.                 inc(clip[2]);
  10621.                 inc(clip[3]);
  10622.                 pxya[0]:=clip[0];
  10623.                 pxya[1]:=clip[1];
  10624.                 pxya[2]:=clip[2];
  10625.                 pxya[3]:=clip[1];
  10626.                 pxya[4]:=clip[2];
  10627.                 pxya[5]:=clip[3];
  10628.                 pxya[6]:=clip[0];
  10629.                 pxya[7]:=clip[3];
  10630.                 pxya[8]:=pxya[0];
  10631.                 pxya[9]:=pxya[1];
  10632.                 v_pline(vdiHandle,5,pxya);
  10633.                 if bTst(parm^.pb_tree^[parm^.pb_obj].ob_flags,DEFAULT) then
  10634.                     begin
  10635.                         dec(clip[0]);
  10636.                         dec(clip[1]);
  10637.                         inc(clip[2]);
  10638.                         inc(clip[3]);
  10639.                         pxya[0]:=clip[0];
  10640.                         pxya[1]:=clip[1];
  10641.                         pxya[2]:=clip[2];
  10642.                         pxya[3]:=clip[1];
  10643.                         pxya[4]:=clip[2];
  10644.                         pxya[5]:=clip[3];
  10645.                         pxya[6]:=clip[0];
  10646.                         pxya[7]:=clip[3];
  10647.                         pxya[8]:=pxya[0];
  10648.                         pxya[9]:=pxya[1];
  10649.                         v_pline(vdiHandle,5,pxya)
  10650.                     end;
  10651.                 gem.vswr_mode(vdiHandle,MD_TRANS);
  10652.                 if bTst(parm^.pr_currstate,DISABLED) then gem.vst_effects(vdiHandle,TF_LIGHTENED);
  10653.                 v_gtext(vdiHandle,tx,ty,btn);
  10654.                 if scpos>0 then
  10655.                     begin
  10656.                         if bTst(parm^.pr_currstate,DISABLED) then gem.vst_effects(vdiHandle,TF_LIGHTENED or TF_UNDERLINED)
  10657.                         else
  10658.                             begin
  10659.                                 gem.vst_effects(vdiHandle,TF_UNDERLINED);
  10660.                                 gem.vst_color(vdihandle,Red)
  10661.                             end;
  10662.                         v_gtext(vdiHandle,tx+(scpos-1)*Attr.charSWidth,ty,' ')
  10663.                     end;
  10664.                 RestoreVWrk
  10665.             end;
  10666.         DrawPushButton:=NORMAL
  10667.     end;
  10668.  
  10669.  
  10670. procedure UpdateGPValues;
  10671.  
  10672.     begin
  10673.     end;
  10674.  
  10675.  
  10676. function GEMVersion: word;
  10677.  
  10678.     begin
  10679.         if Application<>nil then GEMVersion:=GEM_pb.global[0]
  10680.         else
  10681.             GEMVersion:=0
  10682.     end;
  10683.  
  10684.  
  10685. function IsDesktopActive: boolean;
  10686.     var p     : pointer;
  10687.         valid : boolean;
  10688.         nm    : string[9];
  10689.         st,sid: integer;
  10690.  
  10691.     begin
  10692.         if Application<>nil then valid:=Application^.MultiTOS
  10693.         else
  10694.             valid:=false;
  10695.         if valid then
  10696.             begin
  10697.                 wind_update(BEG_UPDATE);
  10698.                 appl_search(2,nm,st,sid);
  10699.                 with AES_pb do
  10700.                     begin
  10701.                         control^[0]:=13;
  10702.                         control^[1]:=0;
  10703.                         control^[3]:=1;
  10704.                         addrin^[0]:=nil
  10705.                     end;
  10706.                 _crystal(@AES_pb);
  10707.                 IsDesktopActive:=(sid=AES_pb.intout^[0]);
  10708.                 wind_update(END_UPDATE)
  10709.             end
  10710.         else
  10711.             begin
  10712.                 p:=GetOSHeaderPtr;
  10713.                 if TOSVersion<$0102 then
  10714.                     begin
  10715.                         if (PWord(longint(p)+28)^ div 2)=SPA then p:=pointer($873c)
  10716.                         else
  10717.                             p:=pointer($602c)
  10718.                     end
  10719.                 else
  10720.                     p:=PPointer(longint(p)+40)^;
  10721.                 IsDesktopActive:=(PDPtr(PPointer(p)^)^.p_tlen=0)
  10722.             end
  10723.     end;
  10724.  
  10725.  
  10726. procedure GetQSB(var p: pointer; var len: longint);
  10727.     var w1,w2,w3,w4: integer;
  10728.  
  10729.     begin
  10730.         if Application<>nil then
  10731.             if Application^.MultiTOS then
  10732.                 begin
  10733.                     p:=nil;
  10734.                     len:=0;
  10735.                     exit
  10736.                 end;
  10737.         wind_get(DESK,WF_SCREEN,w1,w2,w3,w4);
  10738.         p:=Ptr(word(w1),word(w2));
  10739.         len:=longint(Ptr(word(w3),word(w4)));
  10740.         if (len=0) and (GEMVersion=$0120) then len:=8000
  10741.     end;
  10742.  
  10743.  
  10744. function GetTempDir: string;
  10745.     var dummy: string;
  10746.  
  10747.     function gettemp(env: string): boolean;
  10748.         label _test;
  10749.  
  10750.         var fn    : string;
  10751.             p     : pointer;
  10752.             olddta: DTAPtr;
  10753.             newdta: DTA;
  10754.  
  10755.         begin
  10756.             gettemp:=false;
  10757.             shel_envrn(p,env+'=');
  10758.             if p=nil then exit;
  10759.             fn:=StrPTrimF(StrPas(p));
  10760.             if StrPLeft(fn,1)='\' then fn:=BootDevice+':'+fn;
  10761.             if StrPRight(StrPLeft(fn,2),1)<>':' then fn:=BootDevice+':\'+fn;
  10762.             if StrPRight(fn,1)<>'\' then fn:=fn+'\';
  10763.             if not(AppFlag) then wind_update(BEG_UPDATE);
  10764.             olddta:=fgetdta;
  10765.             fsetdta(@newdta);
  10766.             if fsfirst(StrPLeft(fn,length(fn)-1),FA_DIREC)=0 then
  10767.                 begin
  10768.                     _test:
  10769.                     if newdta.d_attrib=FA_DIREC then
  10770.                         begin
  10771.                             gettemp:=true;
  10772.                             GetTempDir:=fn
  10773.                         end
  10774.                     else
  10775.                         if fsnext=0 then goto _test
  10776.                 end;
  10777.             fsetdta(olddta);
  10778.             if not(AppFlag) then wind_update(END_UPDATE)
  10779.         end;
  10780.  
  10781.     begin
  10782.         GetTempDir:=BootDevice+':\';
  10783.         if gettemp('TMPDIR') then exit;
  10784.         if gettemp('TEMPDIR') then exit;
  10785.         if gettemp('TMP') then exit;
  10786.         if gettemp('TEMP') then exit;
  10787.         if gettemp('TRASHDIR') then exit;
  10788.         if Application<>nil then
  10789.             with Application^ do
  10790.                 if apPath<>nil then GetTempDir:=apPath^
  10791.     end;
  10792.  
  10793.  
  10794. function FileSelect(AParent: PWindow; ATitle,AMask: string; var APath,AFile: string; ForceExist: boolean): boolean;
  10795.     label _again;
  10796.  
  10797.     var fname,fpath,npath,dmy: string;
  10798.         exitButton,ret       : integer;
  10799.         dummy                : longint;
  10800.         olddta               : DTAPtr;
  10801.         newdta               : DTA;
  10802.  
  10803.     begin
  10804.         wind_update(BEG_UPDATE);
  10805.         wind_update(BEG_MCTRL);
  10806.         olddta:=FGetdta;
  10807.         Fsetdta(@newdta);
  10808.         FileSelect:=false;
  10809.         if length(APath)=0 then dgetpath(fpath,0)
  10810.         else
  10811.             fpath:=APath;
  10812.         if StrPRight(fpath,1)<>'\' then fpath:=fpath+'\';
  10813.         if StrPRight(StrPLeft(fpath,2),1)<>':' then fpath:=chr(dgetdrv+65)+':'+fpath;
  10814.         if fpath[3]<>'\' then
  10815.             fpath:=StrPLeft(fpath,2)+'\'+StrPRight(fpath,length(fpath)-2);
  10816.         if length(AMask)=0 then fpath:=fpath+'*.*'
  10817.         else
  10818.             fpath:=fpath+AMask;
  10819.         fname:=AFile;
  10820.         _again:
  10821.         if ((GEMVersion>=$0140) and (GEMVersion<$0200)) or (GEMVersion>=$0300) or GetCookie('FSEL',dummy) then
  10822.             ret:=fsel_exinput(fpath,fname,exitButton,ATitle)
  10823.         else
  10824.             ret:=fsel_input(fpath,fname,exitButton);
  10825.         if (exitButton=1) and (ret<>0) and (length(fname)>0) then
  10826.             begin
  10827.                 dummy:=pos('.',AMask);
  10828.                 if ((pos('.',fname)=0) or (StrPRight(fname,1)='.')) and Between(dummy,1,length(AMask)-1) then
  10829.                     begin
  10830.                         dmy:=StrPRight(AMask,length(AMask)-dummy);
  10831.                         if (pos('?',dmy)=0) and (pos('*',dmy)=0) then
  10832.                             begin
  10833.                                 if StrPRight(fname,1)='.' then fname:=fname+dmy
  10834.                                 else
  10835.                                     fname:=fname+'.'+dmy
  10836.                             end
  10837.                     end;
  10838.                 npath:=StrPLeft(fpath,RPos('\',fpath));
  10839.                 if ForceExist then
  10840.                     if not(Exist(npath+fname)) then
  10841.                         begin
  10842.                             if Application<>nil then
  10843.                                 with Application^ do
  10844.                                     begin
  10845.                                         if (Attr.Country=FRG) or (Attr.Country=SWG) then Alert(nil,1,NOTE,'"'+fname+'" existiert nicht.','  &OK  ')
  10846.                                         else
  10847.                                             Alert(nil,1,NOTE,'"'+fname+'" does not exist.','  &OK  ')
  10848.                                     end
  10849.                             else
  10850.                                 form_alert(1,'[1][ | | |"'+fname+'" existiert nicht.  ][   OK   ]');
  10851.                             goto _again
  10852.                         end;
  10853.                 APath:=npath;
  10854.                 AFile:=fname;
  10855.                 FileSelect:=true
  10856.             end;
  10857.         Fsetdta(olddta);
  10858.         wind_update(END_MCTRL);
  10859.         wind_update(END_UPDATE);
  10860.         if Application<>nil then
  10861.             Application^.RestoreModalDialog(AParent)
  10862.     end;
  10863.  
  10864.  
  10865. function OpenPrivateProfile(FileName: string): boolean;
  10866.     label _error,_exit;
  10867.  
  10868.     var f: text;
  10869.         t: string;
  10870.  
  10871.     begin
  10872.         OpenPrivateProfile:=false;
  10873.         if profile<>nil then exit;
  10874.         if Application<>nil then
  10875.             with Application^ do
  10876.                 if apPath<>nil then
  10877.                     if pos('\',FileName)=0 then FileName:=apPath^+FileName;
  10878.         profilename:=NewStr(StrPUpper(FileName));
  10879.         if profilename=nil then exit;
  10880.         new(profile,Init(50,25));
  10881.         if profile=nil then
  10882.             begin
  10883.                 DisposeStr(profilename);
  10884.                 exit
  10885.             end;
  10886.         profilechng:=false;
  10887.         if Exist(FileName) then
  10888.             begin
  10889.                 wind_update(BEG_UPDATE);
  10890.                 BusyMouse;
  10891.                 assign(f,FileName);
  10892.                 reset(f);
  10893.                 if ioresult<>0 then goto _exit;
  10894.                 while not(eof(f)) do
  10895.                     begin
  10896.                         if ioresult<>0 then goto _error;
  10897.                         readln(f,t);
  10898.                         profile^.Insert(ChrNew(StrPTrimF(t)))
  10899.                     end;
  10900.                 _error:
  10901.                 close(f);
  10902.                 ioresult;
  10903.                 OpenPrivateProfile:=true;
  10904.                 _exit:
  10905.                 ArrowMouse;
  10906.                 wind_update(END_UPDATE)
  10907.             end
  10908.     end;
  10909.  
  10910.  
  10911. function SavePrivateProfile: boolean;
  10912.     label _exit,_close;
  10913.  
  10914.     var tfile : string;
  10915.         f,ftmp: text;
  10916.         q     : longint;
  10917.  
  10918.     begin
  10919.         SavePrivateProfile:=false;
  10920.         if profile<>nil then
  10921.             begin
  10922.                 if profilechng then
  10923.                     begin
  10924.                         wind_update(BEG_UPDATE);
  10925.                         BusyMouse;
  10926.                         tfile:=GetPath(profilename^)+GetTempFilename;
  10927.                         assign(ftmp,tfile);
  10928.                         assign(f,profilename^);
  10929.                         rewrite(ftmp);
  10930.                         if ioresult<>0 then goto _exit;
  10931.                         if profile^.Count>0 then
  10932.                             for q:=0 to profile^.Count-1 do
  10933.                                 if profile^.At(q)<>nil then
  10934.                                     begin
  10935.                                         if ioresult<>0 then goto _close;
  10936.                                         writeln(ftmp,PChar(profile^.At(q)))
  10937.                                     end;
  10938.                         _close:
  10939.                         close(ftmp);
  10940.                         ioresult;
  10941.                         erase(f);
  10942.                         ioresult;
  10943.                         rename(ftmp,profilename^);
  10944.                         if ioresult=0 then
  10945.                             begin
  10946.                                 SavePrivateProfile:=true;
  10947.                                 profilechng:=false
  10948.                             end;
  10949.                         _exit:
  10950.                         ArrowMouse;
  10951.                         wind_update(END_UPDATE)
  10952.                     end
  10953.                 else
  10954.                     SavePrivateProfile:=true
  10955.             end
  10956.     end;
  10957.  
  10958.  
  10959. function ClosePrivateProfile: boolean;
  10960.  
  10961.     begin
  10962.         if profile<>nil then
  10963.             begin
  10964.                 ClosePrivateProfile:=SavePrivateProfile;
  10965.                 dispose(profile,Done);
  10966.                 DisposeStr(profilename);
  10967.                 profile:=nil
  10968.             end
  10969.         else
  10970.             ClosePrivateProfile:=false
  10971.     end;
  10972.  
  10973.  
  10974. function WritePrivateProfileString(AppName,KeyName,Value,FileName: string): boolean;
  10975.     label _exit,_error,_closeall,_fertig;
  10976.  
  10977.     var f,ftmp        : text;
  10978.         t,ca,key,aname,
  10979.         kname,tfile   : string;
  10980.         p             : integer;
  10981.         found         : boolean;
  10982.         q             : longint;
  10983.  
  10984.     begin
  10985.         aname:=StrPUpper(StrPTrimF(AppName));
  10986.         kname:=StrPUpper(StrPTrimF(KeyName));
  10987.         WritePrivateProfileString:=false;
  10988.         if (length(aname)=0) or (length(kname)=0) then exit;
  10989.         if Application<>nil then
  10990.             with Application^ do
  10991.                 if apPath<>nil then
  10992.                     if pos('\',FileName)=0 then FileName:=apPath^+FileName;
  10993.         ca:='';
  10994.         found:=false;
  10995.         if profile<>nil then
  10996.             if profilename^=StrPUpper(FileName) then
  10997.                 begin
  10998.                     q:=0;
  10999.                     while q<profile^.Count do
  11000.                         begin
  11001.                             if profile^.At(q)=nil then
  11002.                                 begin
  11003.                                     inc(q);
  11004.                                     continue
  11005.                                 end;
  11006.                             t:=StrPTrimF(StrPas(profile^.At(q)));
  11007.                             if StrPLeft(t,1)=';' then
  11008.                                 begin
  11009.                                     inc(q);
  11010.                                     continue
  11011.                                 end;
  11012.                             if (StrPLeft(t,1)='[') and (StrPRight(t,1)=']') then
  11013.                                 ca:=StrPUpper(copy(t,2,length(t)-2))
  11014.                             else
  11015.                                 if ca=aname then
  11016.                                     begin
  11017.                                         if length(t)=0 then
  11018.                                             begin
  11019.                                                 if length(Value)>0 then
  11020.                                                     profile^.AtInsert(q,ChrNew(StrPTrimF(KeyName)+'='+Value));
  11021.                                                 found:=true;
  11022.                                                 goto _fertig
  11023.                                             end
  11024.                                         else
  11025.                                             begin
  11026.                                                 p:=pos('=',t);
  11027.                                                 if p>0 then
  11028.                                                     if StrPUpper(StrPLeft(t,p-1))=kname then
  11029.                                                         begin
  11030.                                                             if length(Value)>0 then
  11031.                                                                 begin
  11032.                                                                     profile^.FreeItem(profile^.At(q));
  11033.                                                                     profile^.AtPut(q,ChrNew(StrPTrimF(KeyName)+'='+Value))
  11034.                                                                 end
  11035.                                                             else
  11036.                                                                 profile^.AtFree(q);
  11037.                                                             found:=true;
  11038.                                                             goto _fertig
  11039.                                                         end
  11040.                                             end
  11041.                                     end;
  11042.                             inc(q)
  11043.                         end;
  11044.                     _fertig:
  11045.                     if not(found) then
  11046.                         begin
  11047.                             if ca<>aname then profile^.Insert(ChrNew('['+StrPTrimF(AppName)+']'));
  11048.                             if length(Value)>0 then profile^.Insert(ChrNew(StrPTrimF(KeyName)+'='+Value));
  11049.                             profile^.Insert(ChrNew(''))
  11050.                         end;
  11051.                     WritePrivateProfileString:=true;
  11052.                     profilechng:=true;
  11053.                     exit
  11054.                 end;
  11055.         wind_update(BEG_UPDATE);
  11056.         tfile:=GetPath(FileName)+GetTempFilename;
  11057.         assign(f,FileName);
  11058.         if not(Exist(FileName)) then
  11059.             begin
  11060.                 rewrite(f);
  11061.                 if ioresult<>0 then goto _exit;
  11062.                 close(f)
  11063.             end;
  11064.         rename(f,tfile);
  11065.         if ioresult<>0 then goto _exit;
  11066.         assign(f,FileName);
  11067.         assign(ftmp,tfile);
  11068.         rewrite(f);
  11069.         if ioresult<>0 then goto _exit;
  11070.         reset(ftmp);
  11071.         if ioresult<>0 then goto _error;
  11072.         while not(eof(ftmp)) do
  11073.             begin
  11074.                 if ioresult<>0 then goto _closeall;
  11075.                 readln(ftmp,t);
  11076.                 StrPTrim(t);
  11077.                 if (found) or (StrPLeft(t,1)=';') then writeln(f,t)
  11078.                 else
  11079.                     begin
  11080.                         if (StrPLeft(t,1)='[') and (StrPRight(t,1)=']') then
  11081.                             begin
  11082.                                 writeln(f,t);
  11083.                                 ca:=StrPUpper(copy(t,2,length(t)-2))
  11084.                             end
  11085.                         else
  11086.                             begin
  11087.                                 if ca=aname then
  11088.                                     begin
  11089.                                         if length(t)=0 then
  11090.                                             begin
  11091.                                                 if length(Value)>0 then
  11092.                                                     writeln(f,StrPTrimF(KeyName)+'='+Value);
  11093.                                                 writeln(f);
  11094.                                                 found:=true
  11095.                                             end
  11096.                                         else
  11097.                                             begin
  11098.                                                 p:=pos('=',t);
  11099.                                                 if p>0 then
  11100.                                                     begin
  11101.                                                         if StrPUpper(StrPLeft(t,p-1))=kname then
  11102.                                                             begin
  11103.                                                                 if length(Value)>0 then
  11104.                                                                     writeln(f,StrPTrimF(KeyName)+'='+Value);
  11105.                                                                 found:=true
  11106.                                                             end
  11107.                                                         else
  11108.                                                             writeln(f,t)
  11109.                                                     end
  11110.                                             end
  11111.                                     end
  11112.                                 else
  11113.                                     writeln(f,t)
  11114.                             end
  11115.                     end
  11116.             end;
  11117.         if not(found) then
  11118.             begin
  11119.                 if ca<>aname then writeln(f,'['+StrPTrimF(AppName)+']');
  11120.                 if length(Value)>0 then writeln(f,StrPTrimF(KeyName)+'='+Value);
  11121.                 writeln(f)
  11122.             end;
  11123.         WritePrivateProfileString:=true;
  11124.         _closeall:
  11125.         close(ftmp);
  11126.         _error:
  11127.         close(f);
  11128.         erase(ftmp);
  11129.         _exit:
  11130.         wind_update(END_UPDATE);
  11131.         ioresult
  11132.     end;
  11133.  
  11134.  
  11135. function WritePrivateProfileInt(AppName,KeyName: string; Value: longint; FileName: string): boolean;
  11136.  
  11137.     begin
  11138.         WritePrivateProfileInt:=WritePrivateProfileString(AppName,KeyName,ltoa(Value),FileName)
  11139.     end;
  11140.  
  11141.  
  11142. function GetPrivateProfileString(AppName,KeyName,Default,FileName: string): string;
  11143.     label _exit,_error,_default;
  11144.  
  11145.     var f   : text;
  11146.         t,ca: string;
  11147.         p   : integer;
  11148.         q   : longint;
  11149.  
  11150.     begin
  11151.         AppName:=StrPUpper(StrPTrimF(AppName));
  11152.         KeyName:=StrPUpper(StrPTrimF(KeyName));
  11153.         if (length(AppName)=0) or (length(KeyName)=0) then goto _default;
  11154.         if Application<>nil then
  11155.             with Application^ do
  11156.                 if apPath<>nil then
  11157.                     if pos('\',FileName)=0 then
  11158.                         FileName:=apPath^+FileName;
  11159.         ca:='';
  11160.         if profile<>nil then
  11161.             if profilename^=StrPUpper(FileName) then
  11162.                 begin
  11163.                     q:=0;
  11164.                     while q<profile^.Count do
  11165.                         begin
  11166.                             if profile^.At(q)=nil then
  11167.                                 begin
  11168.                                     inc(q);
  11169.                                     continue
  11170.                                 end;
  11171.                             t:=StrPTrimF(StrPas(profile^.At(q)));
  11172.                             if (StrPLeft(t,1)='[') and (StrPRight(t,1)=']') then
  11173.                                 ca:=StrPUpper(copy(t,2,length(t)-2))
  11174.                             else
  11175.                                 if StrPLeft(t,1)<>';' then
  11176.                                     begin
  11177.                                         p:=pos('=',t);
  11178.                                         if p>0 then
  11179.                                             if StrPUpper(StrPLeft(t,p-1))=KeyName then
  11180.                                                 if ca=AppName then
  11181.                                                     begin
  11182.                                                         GetPrivateProfileString:=StrPRight(t,length(t)-p);
  11183.                                                         exit
  11184.                                                     end
  11185.                                     end;
  11186.                             inc(q)
  11187.                         end;
  11188.                     goto _default
  11189.                 end;
  11190.         wind_update(BEG_UPDATE);
  11191.         assign(f,FileName);
  11192.         reset(f);
  11193.         if ioresult<>0 then goto _exit;
  11194.         while not(eof(f)) do
  11195.             begin
  11196.                 if ioresult<>0 then goto _error;
  11197.                 readln(f,t);
  11198.                 StrPTrim(t);
  11199.                 if (StrPLeft(t,1)='[') and (StrPRight(t,1)=']') then
  11200.                     ca:=StrPUpper(copy(t,2,length(t)-2))
  11201.                 else
  11202.                     if StrPLeft(t,1)<>';' then
  11203.                         begin
  11204.                             p:=pos('=',t);
  11205.                             if p>0 then
  11206.                                 if StrPUpper(StrPLeft(t,p-1))=KeyName then
  11207.                                     if ca=AppName then
  11208.                                         begin
  11209.                                             GetPrivateProfileString:=StrPRight(t,length(t)-p);
  11210.                                             close(f);
  11211.                                             wind_update(END_UPDATE);
  11212.                                             exit
  11213.                                         end
  11214.                         end
  11215.             end;
  11216.         _error:
  11217.         close(f);
  11218.         ioresult;
  11219.         _exit:
  11220.         wind_update(END_UPDATE);
  11221.         _default:
  11222.         GetPrivateProfileString:=Default
  11223.     end;
  11224.  
  11225.  
  11226. function GetPrivateProfileInt(AppName,KeyName: string; Default: longint; FileName: string): longint;
  11227.     var sval : string;
  11228.  
  11229.     begin
  11230.         sval:=GetPrivateProfileString(AppName,KeyName,'',FileName);
  11231.         if sval='' then GetPrivateProfileInt:=Default
  11232.         else
  11233.             GetPrivateProfileInt:=atol(sval)
  11234.     end;
  11235.  
  11236.  
  11237. function graf_mouse(gr_monumber: word; gr_mofaddr: MFORMPtr): integer;
  11238.     const CMAX = IDC_SLICE4;
  11239.                 GOCrs : array[IDC_WAIT..CMAX] of MFORM =
  11240.                ((mf_xhot: 8; mf_yhot: 8; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11241.                  mf_mask: (32767,16385,16385,28667,28027,14006,7020,3544,3416,7148,14006,27995,27307,16385,16385,32767);
  11242.                  mf_data: (0,16382,16382,4100,4740,2376,1168,544,672,1040,2376,4772,5460,16382,16382,0)),
  11243.                 (mf_xhot: 1; mf_yhot: 1; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11244.                  mf_mask: (32760,-32764,-28702,-28895,-28895,-28895,-32767,-32767,-24583,-27303,-25943,-27303,-25943,-24583,-32767,32766);
  11245.                  mf_data: (0,32760,28700,28894,28894,28894,32766,32766,24582,27302,25942,27302,25942,16390,32766,0)),
  11246.                 (mf_xhot: 0; mf_yhot: 0; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11247.                  mf_mask: (-16130,-24125,-28287,-30311,-31247,-31773,-32313,-32625,-32743,-31871,-27709,-22017,-13849,-31513,1278,896);
  11248.                  mf_data: (0,16444,24702,28774,30734,31772,32312,32624,32742,31870,27708,17920,1560,792,768,0)),
  11249.                 (mf_xhot: 1; mf_yhot: 14; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11250.                  mf_mask: (24,36,74,153,309,618,1236,2472,4944,9888,9536,23168,22784,-31232,-26624,-8192);
  11251.                  mf_data: (0,24,52,102,202,404,808,1616,3232,6464,6784,9472,9728,30720,24576,0)),
  11252.                 (mf_xhot: 1; mf_yhot: 1; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11253.                  mf_mask: (-512,-32512,-16768,-20672,-18528,23504,11752,5876,3066,1409,701,317,129,127,0,0);
  11254.                  mf_data: (0,32256,16640,20608,18496,9248,4624,2312,1028,638,322,194,126,0,0,0)),
  11255.                 (mf_xhot: 1; mf_yhot: 1; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11256.                  mf_mask: (-8192,-28672,-30720,17408,8704,4352,2718,1377,685,333,417,542,720,720,528,480);
  11257.                  mf_data: (0,24576,28672,14336,7168,3584,1280,670,338,178,94,480,288,288,480,0)),
  11258.                 (mf_xhot: 1; mf_yhot: 1; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11259.                  mf_mask: (24576,-28672,-20736,20608,11328,11040,10128,10192,5064,2536,1256,620,290,138,98,28);
  11260.                  mf_data: (0,24576,20480,12032,4992,5312,6240,6176,3120,1552,784,400,220,116,28,0)),
  11261.                             (mf_xhot: 7; mf_yhot: 7; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11262.                              mf_mask: (960,3120,4296,8436,16634,16634,-32515,-32515,-16639,-16639,24322,24322,12036,4872,3120,960);
  11263.                              mf_data: (0,960,3888,7944,16132,16132,32514,32514,16638,16638,8444,8444,4344,3312,960,0)),
  11264.                             (mf_xhot: 7; mf_yhot: 7; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11265.                              mf_mask: (960,3120,4104,8196,20490,22554,-17347,-16771,-16771,-17347,22554,20490,8196,4104,3120,960);
  11266.                              mf_data: (0,960,4080,8184,12276,10212,17346,16770,16770,17346,10212,12276,8184,4080,960,0)),
  11267.                             (mf_xhot: 7; mf_yhot: 7; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11268.                              mf_mask: (960,3120,4872,12036,24322,24322,-16639,-16639,-32515,-32515,16634,16634,8436,4296,3120,960);
  11269.                              mf_data: (0,960,3312,4344,8444,8444,16638,16638,32514,32514,16132,16132,7944,3888,960,0)),
  11270.                             (mf_xhot: 7; mf_yhot: 7; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  11271.                              mf_mask: (960,3120,5064,12276,18402,17346,-32383,-32767,-32767,-32383,17346,18402,12276,5064,3120,960);
  11272.                              mf_data: (0,960,3120,4104,14364,15420,32382,32766,32766,32382,15420,14364,4104,3120,960,0)));
  11273.  
  11274.     var ret: integer;
  11275.         frc: word;
  11276.  
  11277.     begin
  11278.         if bTst(gr_monumber,MFORCE) and Application^.MultiTOS then frc:=MFORCE
  11279.             else frc:=0;
  11280.         gr_monumber:=gr_monumber and $7fff;
  11281.         if gr_monumber=USER_DEF then
  11282.             begin
  11283.                 if gr_mofaddr<>nil then
  11284.                     begin
  11285.                         ret:=gem.graf_mouse(frc or USER_DEF,gr_mofaddr);
  11286.                         if ret<>0 then
  11287.                             begin
  11288.                                 mlnr:=GP.mnr;
  11289.                                 mlform:=GP.mform;
  11290.                                 GP.mnr:=USER_DEF;
  11291.                                 GP.mform:=gr_mofaddr^
  11292.                             end
  11293.                     end
  11294.                 else
  11295.                     ret:=0
  11296.             end
  11297.         else
  11298.             begin
  11299.                 if (gr_monumber>=IDC_WAIT) and (gr_monumber<=CMAX) then
  11300.                     begin
  11301.                         ret:=gem.graf_mouse(frc or USER_DEF,@GOCrs[gr_monumber]);
  11302.                         if (ret<>0) and (longint(gr_mofaddr)<>1) then
  11303.                             begin
  11304.                                 mlnr:=GP.mnr;
  11305.                                 mlform:=GP.mform;
  11306.                                 GP.mnr:=USER_DEF;
  11307.                                 GP.mform:=GOCrs[gr_monumber]
  11308.                             end
  11309.                     end
  11310.                 else
  11311.                     begin
  11312.                         if (gr_monumber>M_ON) and not(Application^.MultiTOS) then ret:=0
  11313.                         else
  11314.                             ret:=gem.graf_mouse(frc or gr_monumber,nil);
  11315.                         if (ret<>0) and (gr_monumber<M_OFF) and (longint(gr_mofaddr)<>1) then
  11316.                             begin
  11317.                                 mlnr:=GP.mnr;
  11318.                                 mlform:=GP.mform;
  11319.                                 GP.mnr:=gr_monumber
  11320.                             end
  11321.                     end
  11322.             end;
  11323.         graf_mouse:=ret
  11324.     end;
  11325.  
  11326.  
  11327. function AppVHnd: integer;
  11328.  
  11329.     begin
  11330.         if Application<>nil then AppVHnd:=Application^.vdiHandle
  11331.             else AppVHnd:=0
  11332.     end;
  11333.  
  11334.  
  11335. function vswr_mode(handle,mode: integer): integer;
  11336.  
  11337.     begin
  11338.         if handle=AppVHnd then
  11339.             begin
  11340.                 GP.wrmode:=gem.vswr_mode(handle,mode);
  11341.                 vswr_mode:=GP.wrmode
  11342.             end
  11343.         else
  11344.             vswr_mode:=gem.vswr_mode(handle,mode)
  11345.     end;
  11346.  
  11347.  
  11348. procedure vsl_udsty(handle,pattern: integer);
  11349.  
  11350.     begin
  11351.         gem.vsl_udsty(handle,pattern);
  11352.         if handle=AppVHnd then GP.ludsty:=pattern
  11353.     end;
  11354.  
  11355.  
  11356. function vsl_type(handle,style: integer): integer;
  11357.  
  11358.     begin
  11359.         if handle=AppVHnd then
  11360.             begin
  11361.                 GP.ltype:=gem.vsl_type(handle,style);
  11362.                 vsl_type:=GP.ltype
  11363.             end
  11364.         else
  11365.             vsl_type:=gem.vsl_type(handle,style)
  11366.     end;
  11367.  
  11368.  
  11369. function vsl_width(handle,width: integer): integer;
  11370.  
  11371.     begin
  11372.         if handle=AppVHnd then
  11373.             begin
  11374.                 GP.lwidth:=gem.vsl_width(handle,width);
  11375.                 vsl_width:=GP.lwidth
  11376.             end
  11377.         else
  11378.             vsl_width:=gem.vsl_width(handle,width)
  11379.     end;
  11380.  
  11381.  
  11382. function vsl_color(handle,color_index: integer): integer;
  11383.  
  11384.     begin
  11385.         if handle=AppVHnd then
  11386.             begin
  11387.                 GP.lcolor:=gem.vsl_color(handle,color_index);
  11388.                 vsl_color:=GP.lcolor
  11389.             end
  11390.         else
  11391.             vsl_color:=gem.vsl_color(handle,color_index)
  11392.     end;
  11393.  
  11394.  
  11395. procedure vsl_ends(handle,beg_style,end_style: integer);
  11396.  
  11397.     begin
  11398.         gem.vsl_ends(handle,beg_style,end_style);
  11399.         if handle=AppVHnd then
  11400.             begin
  11401.                 GP.lendsb:=beg_style;
  11402.                 GP.lendse:=end_style
  11403.             end
  11404.     end;
  11405.  
  11406.  
  11407. function vsm_type(handle,symbol: integer): integer;
  11408.  
  11409.     begin
  11410.         if handle=AppVHnd then
  11411.             begin
  11412.                 GP.mtype:=gem.vsm_type(handle,symbol);
  11413.                 vsm_type:=GP.mtype
  11414.             end
  11415.         else
  11416.             vsm_type:=gem.vsm_type(handle,symbol)
  11417.     end;
  11418.  
  11419.  
  11420. function vsm_height(handle,height: integer): integer;
  11421.  
  11422.     begin
  11423.         if handle=AppVHnd then
  11424.             begin
  11425.                 GP.mheight:=gem.vsm_height(handle,height);
  11426.                 vsm_height:=GP.mheight
  11427.             end
  11428.         else
  11429.             vsm_height:=gem.vsm_height(handle,height)
  11430.     end;
  11431.  
  11432.  
  11433. function vsm_color(handle,color_index: integer): integer;
  11434.  
  11435.     begin
  11436.         if handle=AppVHnd then
  11437.             begin
  11438.                 GP.mcolor:=gem.vsm_color(handle,color_index);
  11439.                 vsm_color:=GP.mcolor
  11440.             end
  11441.         else
  11442.             vsm_color:=gem.vsm_color(handle,color_index)
  11443.     end;
  11444.  
  11445.  
  11446. function vst_font(handle,font: integer): integer;
  11447.  
  11448.     begin
  11449.         if handle=AppVHnd then
  11450.             begin
  11451.                 GP.font:=gem.vst_font(handle,font);
  11452.                 vst_font:=GP.font
  11453.             end
  11454.         else
  11455.             vst_font:=gem.vst_font(handle,font)
  11456.     end;
  11457.  
  11458.  
  11459. function vst_point(handle,point: integer; var char_width,char_height,cell_width,cell_height: integer): integer;
  11460.  
  11461.     begin
  11462.         if point<0 then vst_point:=-1
  11463.         else
  11464.             begin
  11465.                 if handle=AppVHnd then
  11466.                     with GP do
  11467.                         begin
  11468.                             tpoint:=gem.vst_point(handle,point,charWidth,charHeight,boxWidth,boxHeight);
  11469.                             char_width:=charWidth;
  11470.                             char_height:=charHeight;
  11471.                             cell_width:=boxWidth;
  11472.                             cell_height:=boxHeight;
  11473.                             vst_point:=tpoint;
  11474.                             theight:=-1
  11475.                         end
  11476.                 else
  11477.                     vst_point:=gem.vst_point(handle,point,char_width,char_height,cell_width,cell_height)
  11478.             end
  11479.     end;
  11480.  
  11481.  
  11482. procedure vst_height(handle,height: integer; var char_width,char_height,cell_width,cell_height: integer);
  11483.  
  11484.     begin
  11485.         if height>=0 then
  11486.             begin
  11487.                 gem.vst_height(handle,height,char_width,char_height,cell_width,cell_height);
  11488.                 if handle=AppVHnd then
  11489.                     with GP do
  11490.                         begin
  11491.                             charWidth:=char_width;
  11492.                             charHeight:=char_height;
  11493.                             boxWidth:=cell_width;
  11494.                             boxHeight:=cell_height;
  11495.                             theight:=height;
  11496.                             tpoint:=-1
  11497.                         end
  11498.             end
  11499.     end;
  11500.  
  11501.  
  11502. function vst_rotation(handle,angle: integer): integer;
  11503.  
  11504.     begin
  11505.         if handle=AppVHnd then
  11506.             begin
  11507.                 GP.trotation:=gem.vst_rotation(handle,angle);
  11508.                 vst_rotation:=GP.trotation
  11509.             end
  11510.         else
  11511.             vst_rotation:=gem.vst_rotation(handle,angle)
  11512.     end;
  11513.  
  11514.  
  11515. function vst_effects(handle,effect: integer): integer;
  11516.  
  11517.     begin
  11518.         if handle=AppVHnd then
  11519.             begin
  11520.                 GP.teffects:=gem.vst_effects(handle,effect);
  11521.                 vst_effects:=GP.teffects
  11522.             end
  11523.         else
  11524.             vst_effects:=gem.vst_effects(handle,effect)
  11525.     end;
  11526.  
  11527.  
  11528. procedure vst_alignment(handle,hor_in,vert_in: integer; var hor_out,vert_out: integer);
  11529.  
  11530.     begin
  11531.         gem.vst_alignment(handle,hor_in,vert_in,hor_out,vert_out);
  11532.         if handle=AppVHnd then
  11533.             begin
  11534.                 GP.horAlign:=hor_out;
  11535.                 GP.verAlign:=vert_out
  11536.             end
  11537.     end;
  11538.  
  11539.  
  11540. function vst_color(handle,color_index: integer): integer;
  11541.  
  11542.     begin
  11543.         if handle=AppVHnd then
  11544.             begin
  11545.                 GP.tcolor:=gem.vst_color(handle,color_index);
  11546.                 vst_color:=GP.tcolor
  11547.             end
  11548.         else
  11549.             vst_color:=gem.vst_color(handle,color_index)
  11550.     end;
  11551.  
  11552.  
  11553. function vsf_interior(handle,style: integer): integer;
  11554.  
  11555.     begin
  11556.         if handle=AppVHnd then
  11557.             begin
  11558.                 GP.finterior:=gem.vsf_interior(handle,style);
  11559.                 vsf_interior:=GP.finterior
  11560.             end
  11561.         else
  11562.             vsf_interior:=gem.vsf_interior(handle,style)
  11563.     end;
  11564.  
  11565.  
  11566. function vsf_style(handle,style_index: integer): integer;
  11567.  
  11568.     begin
  11569.         if handle=AppVHnd then
  11570.             begin
  11571.                 GP.fstyle:=gem.vsf_style(handle,style_index);
  11572.                 vsf_style:=GP.fstyle
  11573.             end
  11574.         else
  11575.             vsf_style:=gem.vsf_style(handle,style_index)
  11576.     end;
  11577.  
  11578.  
  11579. function vsf_color(handle,color_index: integer): integer;
  11580.  
  11581.     begin
  11582.         if handle=AppVHnd then
  11583.             begin
  11584.                 GP.fcolor:=gem.vsf_color(handle,color_index);
  11585.                 vsf_color:=GP.fcolor
  11586.             end
  11587.         else
  11588.             vsf_color:=gem.vsf_color(handle,color_index)
  11589.     end;
  11590.  
  11591.  
  11592. function vsf_perimeter(handle,per_vis: integer): integer;
  11593.  
  11594.     begin
  11595.         if handle=AppVHnd then
  11596.             begin
  11597.                 GP.fperimeter:=gem.vsf_perimeter(handle,per_vis);
  11598.                 vsf_perimeter:=GP.fperimeter
  11599.             end
  11600.         else
  11601.             vsf_perimeter:=gem.vsf_perimeter(handle,per_vis)
  11602.     end;
  11603.  
  11604.  
  11605. procedure vs_clip(handle,clipflag: integer; pxarray: ARRAY_4);
  11606.  
  11607.     begin
  11608.         gem.vs_clip(handle,clipflag,pxarray);
  11609.         if handle=AppVHnd then
  11610.             if clipflag<>CLIP_OFF then GP.clip:=pxarray
  11611.     end;
  11612.  
  11613.  
  11614. procedure vr_trnfm(handle: integer; psrcMFDB,pdesMFDB: MFDB);
  11615.     var dest: pointer;
  11616.         len : longint;
  11617.  
  11618.     begin
  11619.         if (psrcMFDB.fd_addr=pdesMFDB.fd_addr) and (psrcMFDB.fd_addr<>nil) then
  11620.             begin
  11621.                 len:=(psrcMFDB.fd_wdwidth*psrcMFDB.fd_h*psrcMFDB.fd_nplanes) shl 1;
  11622.                 getmem(dest,len);
  11623.                 if dest=nil then gem.vr_trnfm(handle,psrcMFDB,pdesMFDB)
  11624.                 else
  11625.                     begin
  11626.                         move(psrcMFDB.fd_addr^,dest^,len);
  11627.                         pdesMFDB.fd_addr:=psrcMFDB.fd_addr;
  11628.                         psrcMFDB.fd_addr:=dest;
  11629.                         gem.vr_trnfm(handle,psrcMFDB,pdesMFDB);
  11630.                         freemem(dest,len)
  11631.                     end
  11632.             end
  11633.         else
  11634.             gem.vr_trnfm(handle,psrcMFDB,pdesMFDB)
  11635.     end;
  11636.  
  11637.  
  11638. procedure vr_convert(handle: integer; psrcMFDB: MFDB; format: integer);
  11639.     var pdesMFDB: MFDB;
  11640.  
  11641.     begin
  11642.         if psrcMFDB.fd_stand<>format then
  11643.             begin
  11644.                 pdesMFDB:=psrcMFDB;
  11645.                 pdesMFDB.fd_stand:=format;
  11646.                 vr_trnfm(handle,psrcMFDB,pdesMFDB)
  11647.             end
  11648.     end;
  11649.  
  11650.  
  11651. procedure vdi_fix(var pfd: MFDB; theAddr: pointer; w,h: integer);
  11652.  
  11653.     begin
  11654.         with pfd do
  11655.             begin
  11656.                 fd_addr:=theaddr;
  11657.                 fd_wdwidth:=(w+15) shr 4;
  11658.                 fd_w:=w;
  11659.                 fd_h:=h;
  11660.                 fd_nplanes:=1;
  11661.                 fd_stand:=FF_STAND;
  11662.                 fd_r1:=0;
  11663.                 fd_r2:=0;
  11664.                 fd_r3:=0
  11665.             end
  11666.     end;
  11667.  
  11668.  
  11669. function IsMouseVisible: boolean;
  11670.  
  11671.     begin
  11672.         IsMouseVisible:=(mhstack<=0)
  11673.     end;
  11674.  
  11675.  
  11676. function IsMouseBusy: boolean;
  11677.  
  11678.     begin
  11679.         IsMouseBusy:=(mfstack>0)
  11680.     end;
  11681.  
  11682.  
  11683. procedure ShowMouse;
  11684.  
  11685.     begin
  11686.         gem.graf_mouse(M_ON,nil);
  11687.         dec(mhstack)
  11688.     end;
  11689.  
  11690.  
  11691. procedure HideMouse;
  11692.  
  11693.     begin
  11694.         gem.graf_mouse(M_OFF,nil);
  11695.         inc(mhstack)
  11696.     end;
  11697.  
  11698.  
  11699. procedure ArrowMouse;
  11700.  
  11701.     begin
  11702.         dec(mfstack);
  11703.         if mfstack<=0 then
  11704.             begin
  11705.                 graf_mouse(ARROW,nil);
  11706.                 mfstack:=0;
  11707.             end
  11708.     end;
  11709.  
  11710.  
  11711. procedure BusyMouse;
  11712.  
  11713.     begin
  11714.         graf_mouse(BUSYBEE,nil);
  11715.         inc(mfstack)
  11716.     end;
  11717.  
  11718.  
  11719. procedure SliceMouse;
  11720.  
  11721.     begin
  11722.         inc(mfstack);
  11723.         slmouse:=IDC_SLICE1;
  11724.         SliceMouseNext
  11725.     end;
  11726.  
  11727.  
  11728. procedure SliceMouseNext;
  11729.  
  11730.     begin
  11731.         if IsMouseBusy then
  11732.             begin
  11733.                 graf_mouse(slmouse,nil);
  11734.                 inc(slmouse);
  11735.                 if slmouse>IDC_SLICE4 then slmouse:=IDC_SLICE1
  11736.             end
  11737.     end;
  11738.  
  11739.  
  11740. procedure LastMouse;
  11741.  
  11742.     begin
  11743.         graf_mouse(mlnr,@mlform);
  11744.     end;
  11745.  
  11746.  
  11747. function HeapFunc(size: longint): integer;
  11748.  
  11749.   begin
  11750.       if Application<>nil then Application^.Err:=em_OutOfMemory;
  11751.     HeapFunc:=1
  11752.   end;
  11753.  
  11754.  
  11755. procedure SigHandler(dummy1,dummy2,sig: pointer);
  11756.  
  11757.     begin
  11758.         if Application<>nil then Application^.Status:=em_Terminate
  11759.     end;
  11760.  
  11761.  
  11762. procedure GOExit;
  11763.  
  11764.     begin
  11765.         ExitProc:=OldExit;
  11766.         if appdone and (Application<>nil) then Application^.Done
  11767.     end;
  11768.  
  11769.  
  11770. begin
  11771.     Application:=nil;
  11772.     appdone:=false;
  11773.     profile:=nil;
  11774.     randomize;
  11775.     OldExit:=ExitProc;
  11776.     ExitProc:=@GOExit;
  11777.     HeapError:=@HeapFunc;
  11778.     slmouse:=IDC_SLICE1;
  11779.     mhstack:=0;
  11780.     mfstack:=0
  11781. end.